Access VBA 使用API 讀寫 UTF-8 文本文件的內(nèi)容

Access VBA 使用API 讀寫 UTF-8 文本文件的內(nèi)容

這是一個(gè)轉(zhuǎn)換UTF-8格式文本文件的示例，包括讀取和寫入，需要用到兩個(gè)API函數(shù)：MultiByteToWideChar和WideCharToMultiByte 
 
Public Declare Function MultiByteToWideChar Lib "kernel32" ( _
        ByVal CodePage As Long, _
        ByVal dwFlags As Long, _
        ByRef lpMultiByteStr As Any, _
        ByVal cchMultiByte As Long, _
        ByVal lpWideCharStr As Long, _
        ByVal cchWideChar As Long) As Long
Public Declare Function WideCharToMultiByte Lib "kernel32" ( _
        ByVal CodePage As Long, _
        ByVal dwFlags As Long, _
        ByVal lpWideCharStr As Long, _
        ByVal cchWideChar As Long, _
        ByRef lpMultiByteStr As Any, _
        ByVal cchMultiByte As Long, _
        ByVal lpDefaultChar As String, _
        ByVal lpUsedDefaultChar As Long) As Long
Public Const CP_UTF8 = 65001
' 將輸入文本寫進(jìn)UTF8格式的文本文件
' 輸入
' strInput：文本字符串
' strFile：保存的UTF8格式文件路徑
' bBOM：True表示文件帶"EFBBBF"頭，F(xiàn)alse表示不帶
Sub WriteUTF8File(strInput As String, strFile As String, Optional bBOM As Boolean = True)
    Dim bByte As Byte
    Dim ReturnByte() As Byte
    Dim lngBufferSize As Long
    Dim lngResult As Long
    Dim TLen As Long
 
    ' 判斷輸入字符串是否為空
    If Len(strInput) = 0 Then Exit Sub
    On Error GoTo errHandle
    ' 判斷文件是否存在，如存在則刪除
    If Dir(strFile) <> "" Then Kill strFile
 
    TLen = Len(strInput)
    lngBufferSize = TLen * 3 + 1
    ReDim ReturnByte(lngBufferSize - 1)
    lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strInput), TLen, _
        ReturnByte(0), lngBufferSize, vbNullString, 0)
    If lngResult Then
        lngResult = lngResult - 1
        ReDim Preserve ReturnByte(lngResult)
        Open strFile For Binary As #1
        If bBOM = True Then
            bByte = 239
            Put #1, , bByte
            bByte = 187
            Put #1, , bByte
            bByte = 191
            Put #1, , bByte
        End If
        Put #1, , ReturnByte
        Close #1
    End If
    Exit Sub
errHandle:
    MsgBox Err.Description, , "錯(cuò)誤 - " & Err.Number
End Sub
 
' 讀取UTF8文件并轉(zhuǎn)換為VBA中可讀的字符串
' 輸入
' strFile：UTF8格式文件的路徑
Function readUTF8File(strFile As String) As String
    Dim bByte As Byte
    Dim ReturnByte() As Byte
    Dim lngBufferSize As Long
    Dim strBuffer As String
    Dim lngResult As Long
    Dim bHeader(1 To 3) As Byte
    Dim i As Long
 
    On Error GoTo errHandle
    If Dir(strFile) = "" Then Exit Function
 
     ' 以二進(jìn)制打開文件
    Open strFile For Binary As #1
    ReDim ReturnByte(0 To LOF(1) - 1) As Byte
    ' 讀取前三個(gè)字節(jié)
    Get #1, , bHeader(1)
    Get #1, , bHeader(2)
    Get #1, , bHeader(3)
    ' 判斷前三個(gè)字節(jié)是否為BOM頭
    If bHeader(1) = 239 And bHeader(2) = 187 And bHeader(3) = 191 Then
        For i = 3 To LOF(1) - 1
            Get #1, , ReturnByte(i - 3)
        Next i
    Else
        ReturnByte(0) = bHeader(1)
        ReturnByte(1) = bHeader(2)
        ReturnByte(2) = bHeader(3)
        For i = 3 To LOF(1) - 1
            Get #1, , ReturnByte(i)
        Next i
    End If
    ' 關(guān)閉文件
    Close #1
 
    ' 轉(zhuǎn)換UTF-8數(shù)組為字符串
    lngBufferSize = UBound(ReturnByte) + 1
    strBuffer = String$(lngBufferSize, vbNullChar)
    lngResult = MultiByteToWideChar(65001, 0, ReturnByte(0), _
        lngBufferSize, StrPtr(strBuffer), lngBufferSize)
    readUTF8File = Left(strBuffer, lngResult)
 
    Exit Function
errHandle:
    MsgBox Err.Description, , "錯(cuò)誤 - " & Err.Number
    readUTF8File = ""
End Function
 
' 讀取UTF8文件測(cè)試
Sub readFileTest()
    Dim strFile As String
    Dim strContent As String
    Dim strSaveFile As String
 
    ' 獲取文件名和路徑
    strFile = Application.GetOpenFilename("文本文件,*.txt", , "打開文本文件")
    If strFile = "False" Then Exit Sub
    strContent = readUTF8File(strFile)
    If MsgBox("是否需要保存轉(zhuǎn)換好的ANSI文本？", vbYesNo, "保存") = vbYes Then
        strSaveFile = Application.GetSaveAsFilename(Mid(strFile, InStrRev(strFile, "/") + 1), "文本文件,*.txt")
        If strSaveFile = "False" Then Exit Sub
        Open strSaveFile For Binary As #1
        Put #1, , strContent
        Close #1
    End If
End Sub
 
' 寫入U(xiǎn)TF8文件測(cè)試
Sub writeFileTest()
    Dim strFile As String
    Dim strContent As String
 
    strContent = "這是一個(gè)UTF8文檔測(cè)試"
    strFile = Application.GetSaveAsFilename("", "文本文件,*.txt")
    If strFile = "False" Then Exit Sub
    'WriteUTF8File strContent, strFile
    WriteUTF8File strContent, strFile, False
End Sub