VBA生成UTF-8文件

原创文章,欢迎转载:http://miao.blog/article/vba-write-utf8-txt-file

32 位

Private 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
Private Const CP_UTF8 = 65001

Sub WriteUTF8File(strPath As String, str As String)
    Dim lBufSize As Long
    Dim lRest As Long
    Dim bUTF8() As Byte
    Dim TLen As Long

    TLen = Len(str)
    lBufSize = TLen * 3 + 1
    ReDim bUTF8(lBufSize - 1)
    lRest = WideCharToMultiByte(CP_UTF8, 0, StrPtr(str), TLen, bUTF8(0), lBufSize, vbNullString, 0)
    If lRest Then
        lRest = lRest - 1
        ReDim Preserve bUTF8(lRest)
        Open strPath For Binary As #1
        Put #1, , bUTF8
        Close #1
    End If
End Sub

64 位

Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" ( _
        ByVal CodePage As Long, _
        ByVal dwFlags As Long, _
        ByVal lpWideCharStr As LongLong, _
        ByVal cchWideChar As Long, _
        ByRef lpMultiByteStr As Any, _
        ByVal cchMultiByte As Long, _
        ByVal lpDefaultChar As String, _
        ByVal lpUsedDefaultChar As Long) As Long

Private Const CP_UTF8 = 65001

Sub WriteUTF8File(strPath As String, str As String)
    Dim lBufSize As Long
    Dim lRest As Long
    Dim bUTF8() As Byte
    Dim TLen As Long
    TLen = Len(str)
    lBufSize = TLen * 3 + 1
    ReDim bUTF8(lBufSize - 1)
    lRest = WideCharToMultiByte(CP_UTF8, 0, StrPtr(str), TLen, bUTF8(0), lBufSize, vbNullString, 0)
    If lRest Then
        lRest = lRest - 1
        ReDim Preserve bUTF8(lRest)
        Open strPath For Binary As #1
        Put #1, , bUTF8
        Close #1
    End If
End Sub
推荐阅读
VBA发送GET、POST请求的方法
VBA中进行copy和paste的时候,无规律的出现 “类Worksheet的Paste方法无效”错误 怀疑是电脑太快,copy操作还没有完成,就直接运行paste,导致paste出错。 所以在copy操作后,sleep一小段时间,结果真的解决了问题。
评论