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

masterjian · 发表于 2009-12-16 08:25

前段时间，因为项目需要，需要用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 · 发表于 2009-12-16 08:44

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

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

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

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

masterjian · 发表于 2009-12-16 12:05

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

3Q

lb_bn · 发表于 2009-12-16 12:25

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

winland · 发表于 2009-12-16 13:06

以前的一个代码，不写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 · 发表于 2009-12-16 13:32

谢谢版主，学习。

masterjian · 发表于 2009-12-20 11:56

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

masterjian · 发表于 2010-4-23 20:07

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

winland · 发表于 2010-4-23 22:05

复制错了，这个是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 · 发表于 2010-4-23 22:24

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

		自动登录	找回密码
密码			免费注册

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

回复 3楼 joforn 的帖子

回复 6楼 winland 的帖子

回复 6楼 winland 的帖子