安徽彩票大奖 欧洲百万乐透大奖 七星彩17049规律大奖 双色球中大奖领奖过程 3d近期中大奖故事 广州番禺中福彩大奖的 鸡男注定会中大奖 2016江苏彩民中大奖 趣彩网大奖网黑平台 大乐透4.97亿大奖 霍邱一彩民6元中双色球547万大奖 双色球黑龙江中大奖图 体育彩票中大奖名单 什么样的人能中大奖 彩票大奖作假

Access VBA 使用API 读写 UTF-8 文本文件的内容

2017-07-26 17:42:00
zstmtony
转贴
705

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:文本?#22336;?#20018;
' 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
 
    ' 判断输入?#22336;?#20018;是否为空
    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中可读的?#22336;?#20018;
' 输入
' 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数组为?#22336;?#20018;
    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
分享
? 1999-2019 Office交流网?? 中山市天鸣科技发展有限公司 粤ICP备10043721号-5 SQL查询:18
内存占用:7.75MB
PHP 执行时间:0.23
双色球大奖2000年
安徽彩票大奖 欧洲百万乐透大奖 七星彩17049规律大奖 双色球中大奖领奖过程 3d近期中大奖故事 广州番禺中福彩大奖的 鸡男注定会中大奖 2016江苏彩民中大奖 趣彩网大奖网黑平台 大乐透4.97亿大奖 霍邱一彩民6元中双色球547万大奖 双色球黑龙江中大奖图 体育彩票中大奖名单 什么样的人能中大奖 彩票大奖作假