VB生成UTF-8文件

'所用到的API引入
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
' 将输入文本写进UTF8格式的文本文件
' 输入
' strInput：文本字符串
' strFile：保存的UTF8格式文件路径
' bBOM：True表示文件带"EFBBBF"头，False表示不带
Sub WriteUTF8File(strInput As String, strFile As String, Optional bBOM As Boolean = True)
    Dim CP_UTF8 As String
    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
    
    CP_UTF8 = 65001
    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