Access VBA 使用API 讀寫 UTF-8 文本文件的內容

Access VBA 使用API 讀寫 UTF-8 文本文件的內容

這是一箇轉換UTF-8格式文本文件的示例，包括讀取和寫入，需要用到兩箇API函數：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
' 將輸入文本寫進UTF8格式的文本文件
' 輸入
' strInput：文本字符串
' strFile：保存的UTF8格式文件路徑
' bBOM：True錶示文件帶"EFBBBF"頭，False錶示不帶
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, , "錯誤 - " & Err.Number
End Sub
 
' 讀取UTF8文件併轉換爲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
 
     ' 以二進製打開文件
    Open strFile For Binary As #1
    ReDim ReturnByte(0 To LOF(1) - 1) As Byte
    ' 讀取前三箇字節
    Get #1, , bHeader(1)
    Get #1, , bHeader(2)
    Get #1, , bHeader(3)
    ' 判斷前三箇字節是否爲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
    ' 關閉文件
    Close #1
 
    ' 轉換UTF-8數組爲字符串
    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, , "錯誤 - " & Err.Number
    readUTF8File = ""
End Function
 
' 讀取UTF8文件測試
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("是否需要保存轉換好的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
 
' 寫入UTF8文件測試
Sub writeFileTest()
    Dim strFile As String
    Dim strContent As String
 
    strContent = "這是一箇UTF8文檔測試"
    strFile = Application.GetSaveAsFilename("", "文本文件,*.txt")
    If strFile = "False" Then Exit Sub
    'WriteUTF8File strContent, strFile
    WriteUTF8File strContent, strFile, False
End Sub