再谈如何用VBA生成utf-8编码的文件

masterjian

前段时间，因为项目需要，需要用Excel管理国际化资源文件的字符串，
旨在用VBA直接生成资源文件。

但是遇到一个问题，就是：

VBA生成的文本文件，默认是Gb2312编码（与系统的一致），所以我就
只能生成UTF-8格式的了。但是，用FSO生成的UTF格式是【UTF-16LE】
VS2008不识别。。。
郁闷之余，只能用MADC来生成。但是，情况又出现了，用MADC生成的UTF-8
文件默认是带BOM头的。。。

所以，逼上梁山的我就这能用下面的办法来实现UTF-8 无BOM头的写：

Private Sub WriteOut(strPath As String, str As String)

    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")
   
    With objStream
        .Type = 2               'adTypeText
        .Charset = "UTF-8"
        .Open
        .WriteText str
        .SaveToFile strPath, 2  'adSaveCreateOverWrite
    End With
   
    Set objStream = Nothing
End Sub


Public Function Convert2utf8(fileName As String, FileTo As String) As Boolean


    Dim ReadIntFileNum, WriteIntFileNum As Integer
    ReadIntFileNum = FreeFile() '获取一个空文件
    WriteIntFileNum = FreeFile() + 1
   
   
    Open fileName For Binary As ReadIntFileNum
    Open FileTo For Binary As #WriteIntFileNum
'    Dim byteFrom, byteTo As String
    Dim fileByte As Long
    Seek #ReadIntFileNum, 4
   
    While Not EOF(ReadIntFileNum)
   
        Get #ReadIntFileNum, , fileByte
        Put #WriteIntFileNum, , fileByte
    Wend
   
    Close #ReadIntFileNum
    Close #WriteIntFileNum
    Kill fileName
End Function


在使用的时候，先用WriteOut生成一个临时文件(UTF-8带BOM），
然后用Convert2utf8将BOM头的前三个字节删除。

joforn

原帖由 masterjian 于 2009-12-16 08:25 发表
前段时间，因为项目需要，需要用Excel管理国际化资源文件的字符串，
旨在用VBA直接生成资源文件。

但是遇到一个问题，就是：

VBA生成的文本文件，默认是Gb2312编码（与系统的一致），所以我就
只能生成UTF-8 ...

直接Seek到4,然后一次读完，再一次写完，可能会快一些。

masterjian

楼上的逻辑挺好的。
当时只是为了赶紧做完国际化的自动生成，所以，没有考虑IO的速度是所有程序的瓶颈。

3Q

lb_bn

南宫老师可否示例优化一下楼主的代码，谢谢。

winland

以前的一个代码，不写BOM文件头，就是你要求的结果了。
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 Const CP_UTF8 = 65001
Private Sub WriteOut(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

lb_bn

谢谢版主，学习。

masterjian

谢谢了。
我用的那种办法是投机取巧，版主的这个才是正道！

masterjian

版主的这个方法我试了。不行
WideCharToMultiByte函数找不到

winland

复制错了，这个是WideCharToMultiByte函数。
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

wbz2cdma

请高手帮我看看这个帖子：
http://club.excelhome.net/thread-565085-1-1.html