在ACCESS中 將文本文件中的簡體轉換成繁體的問題﹗
請問各位高手,能不能將附件中的vb源易做图轉換到 OFFICE ACCESS 中 使用,謝謝!以下是源易做图:
Public Function CodeX_To_CodeY(ByVal strIn As String, ByVal intCodePage As Integer) As String
' 1、 利用 strConv 函數將 Unicode 字串轉換成 DBCS +SBCS 字串；
' 2、 計算長度 (以bytes為單位，即英文文字算一字，中文算二個字。)；
' 3、 取出每一字的第一位元組數值、第二位元組數值。(此一部份請參考王國榮一書的介紹)；
' 4、 其次依據第一、第二位元數值，找出簡體中文對照表 (tbl936) 裡的繁體中文的索引值；
' 5、 根據索引值，找出陣列裡相對位置的數值 (X)；
' 6、 利用 Chr(x) 函數轉換相對的繁體中文。有關程式易做图只節錄三函數 (codeX_To_CodeY,CrossRef,InCodePage) 之一如下：
'
' 只要擴增對照表範圍，如 CNS、ETEN、MAC、HZ 等，本函數相對在 SELECT...END SELECT 區擴充即可。
'
Dim bytIn() As Byte
Dim bytTemp(1) As Byte
Dim lngCrossNo As Long
Dim lngIndex As Long
Dim lngLength As Long
Dim strOut As String
On Error Resume Next
' 若「是否載入成功」之值為否，則呼叫「載入BIG 5, GB對照資料」程序。
If Not mblnLoadData Then Call LoadArrayFromDatabase
' 若「是否載入成功」之值為否，讓傳入值放置於傳回值(=不變)。
If Not mblnLoadData Then
CodeX_To_CodeY = strIn
Exit Function
End If
' strConv函數將Unicode字串轉換成 DBCS +SBCS字串
' 即英文文字算一字，中文算二個字。
bytIn = StrConv(strIn, vbFromUnicode)
' 陣列長度。
lngLength = UBound(bytIn)
' 索引起始值。
lngIndex = 0
Do While lngIndex <= lngLength
' 放置第一位元組。(176)
bytTemp(0) = bytIn(lngIndex)
' 放置第二位元組。(162)
bytTemp(1) = bytIn(lngIndex + 1)
' 將第一位元組及第二位組轉換成對照表裡的次序編號(Order Number)。
' 如「阿」字， Big 5 CODE 為AAFC (170,252)
' 經計算lngCrossNo = 1567
' 至tbl950資料表去找欄位 OrderNo = 1567，則在欄位 Code 為 GB CODE 對照易做图 B0A2 。
' 如「阿」字， GB CODE 為B0A2 (176,162)
' 經計算lngCrossNo = 1411
' 至tbl936資料表去找欄位 OrderNo = 1411，則在欄位 Code為 Big 5對照易做图 AAFC。
lngCrossNo = CrossRef(bytTemp, intCodePage)
Select Case intCodePage
Case 936 ' GB Code.
' 判斷字元是否為GB Code，與對照號易做图是否位於 [0,8177] 區間。
If InCodePage(bytTemp, intCodePage) And (lngCrossNo >= 0) And (lngCrossNo <= 8177) Then
' 利用 CHR 函數轉換對照表相對的Big 5 Code
' val("&hAAFC") = -21764
' chr(-21764) = "阿"
strOut = strOut & Chr(mintOrder936(lngCrossNo))
lngIndex = lngIndex + 2
' 如果不符合條件，可以判斷為Ascii。
Else
strOut = strOut & Chr(bytTemp(0))
lngIndex = lngIndex + 1
End If
Case 950 ' Big 5 Code.
' 判斷字元是否為BIG 5 Code，與對照號易做图是否位於 [0,14757] 區間。
If InCodePage(bytTemp, intCodePage) And (lngCrossNo >= 0) And (lngCrossNo <= 14757) Then
' 利用 CHR 函數轉換對照表相對的Big 5 Code
' val("&hAAFC") = -20318
' chr(-20318) = "阿" (請用簡體中文系統檢視)
strOut = strOut & Chr(mintOrder950(lngCrossNo))
lngIndex = lngIndex + 2
' 如果不符合條件，可以判斷為Ascii。
Else
strOut = strOut & Chr(bytTemp(0))
lngIndex = lngIndex + 1
End If
End Select
Loop
CodeX_To_CodeY = strOut
End Function
Private Function CrossRef(ByRef bytChrString() As Byte, ByVal intCodePage As Integer) As Long
Dim intX As Integer
Dim intY As Integer
On Error GoTo CrossRef_EH
intX = bytChrString(0)
intY = bytChrString(1)
Select Case intCodePage
Case 936
CrossRef = (intX - 161) * 94 + (intY - 161)
Case 950
If (intY >= 64) And (intY <= 126) Then
CrossRef = (intX - 161) * 157 + (intY - 64)
End If
If (intY >= 161) And (intY <= 254) Then
CrossRef = (intX - 161) * 157 + 63 + (intY - 161)
End If
End Select
Exit Function
CrossRef_EH:
CrossRef = -1
End Function
--------------------编程问答-------------------- 主要是以下代易做图如何融合到access中:Public Sub LoadArrayFromDatabase()
Dim lngCnt As Integer
Dim objConn As ADODB.Connection
Dim objField As ADODB.Field
Dim objRec As ADODB.Recordset
Dim strSQL(1 To 2) As String
'On Error GoTo LoadArrayFromDatabase_EH
mblnLoadData = True
strSQL(1) = "SELECT CODE FROM tbl950 ORDER BY ORDERNO "
strSQL(2) = "SELECT CODE FROM tbl936 ORDER BY ORDERNO "
Set objConn = New ADODB.Connection
objConn.Open gstrConnectionString
Set objRec = New ADODB.Recordset
objRec.CursorLocation = adUseClient
objRec.Open strSQL(1), objConn, adOpenDynamic, adLockReadOnly
Set objField = objRec.Fields(CODE)
For lngCnt = 0 To 14757
mintOrder950(lngCnt) = Val("&H" & objField.Value)
objRec.MoveNext
Next lngCnt
objRec.Close
'
Set objRec = New ADODB.Recordset
objRec.CursorLocation = adUseClient
objRec.Open strSQL(2), objConn, adOpenDynamic, adLockReadOnly
Set objField = objRec.Fields(CODE)
For lngCnt = 0 To 8177
mintOrder936(lngCnt) = Val("&H" & objField.Value)
objRec.MoveNext
Next lngCnt
objRec.Close
objConn.Close
Exit Sub
LoadArrayFromDatabase_EH:
mblnLoadData = False
End Sub
謝謝~ --------------------编程问答-------------------- 這是 adodb 的聯接
Public Function gstrDBFile_CodePage() As String
gstrDBFile_CodePage = CurrentProject.Connection '.Path & "\CodePage.mdb"
End Function
Public Function gstrConnectionString()
gstrConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & gstrDBFile_CodePage
End Function
补充：VB , VBA
