VBA使用UTF-16输出到文件

时间:2012-02-01 07:54:57

标签: xml vba utf-16 byte-order-mark

我有一个很难解释的非常复杂的问题。互联网上有很多关于此的讨论,但没有任何确定性。 非常赞赏任何帮助,或者比我更好的解释。

基本上,我只是尝试使用带有VBA的UTF-16编写XML文件。

如果我这样做:

sXML = "<?xml version='1.0' encoding='utf-8'?>"
sXML = sXML & rest_of_xml_document
Print #iFile, sXML

然后我得到一个有效的XML文件。但是,如果我将“encoding =”更改为“utf-16”,我会从XML验证器中收到此错误:

Switch from current encoding to specified encoding not supported.

谷歌搜索告诉我,这意味着xml编码属性与文件使用的ACTUAL编码不同,因此我必须通过打开和打印命令创建utf-8文档。

如果我这样做:

With CreateObject("ADODB.Stream")
  .Type = 2
  .Charset = "utf-16"
  .Open
  .WriteText sXML
  .SaveToFile sFilename, 2
  .Close
End With

然后我在文件开头有一些时髦的字符(BOM), 导致它无法通过XML验证

如果我在Notepad ++中打开文件,删除BOM并将编码更改为“UCS-2”,然后文件使用“utf-16”编码值进行验证(意味着UCS-2足够接近UTF) -16无关紧要,或者XML在这两种类型之间能够Switch from current encoding

我需要使用UTF-16,因为UTF-8并未涵盖我正在导出的演示文稿中使用的所有字符。

问题:

如何让VBA像Notepad ++一样运行,创建一个UTF-16编码的文本文件而没有可以填充XML数据的BOM?任何帮助非常感谢!

1 个答案:

答案 0 :(得分:5)

您对UTF-8无法存储您需要的所有字符的观点无效 UTF-8能够存储Unicode标准中定义的每个字符 唯一的区别是,对于某些语言的文本,UTF-8可以占用更多的空间来存储其代码点,比如UTF-16。反之亦然:对于某些其他语言,例如英语,使用UTF-8 保存空间。

VB6和VBA虽然以Unicode格式在内存中存储字符串,但在执行文件IO时会隐式切换到ANSI(使用当前系统代码页)。您得到的结果文件不是UTF-8。它位于您当前的系统代码页中,正如您在this helpful article中发现的那样,如果您来自美国,它看起来就像UTF-8。

尝试:

Dim s As String
s = "<?xml version='1.0' encoding='utf-16'?>"
s = s & ChrW$(&H43F&) & ChrW$(&H440&) & ChrW$(&H43E&) & ChrW$(&H432&) & ChrW$(&H435&) & ChrW$(&H440&) & ChrW$(&H43A&) & ChrW$(&H430&)

Dim b() As Byte
b = s

Open "Unicode.txt" For Binary Access Write As #1
Put #1, , b
Close #1

如果你绝对必须拥有UTF-8,你可以自己做一些:

Option Explicit

Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Byte, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByRef lpUsedDefaultChar As Long) As Long

Private Const CP_UTF8 As Long = 65001
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122&


Public Function ToUTF8(s As String) As Byte()

  If Len(s) = 0 Then Exit Function


  Dim ccb As Long
  ccb = WideCharToMultiByte(CP_UTF8, 0, StrPtr(s), Len(s), ByVal 0&, 0, vbNullString, ByVal 0&)

  If ccb = 0 Then
    Err.Raise 5, , "Internal error."
  End If

  Dim b() As Byte
  ReDim b(1 To ccb)

  If WideCharToMultiByte(CP_UTF8, 0, StrPtr(s), Len(s), b(LBound(b)), ccb, vbNullString, ByVal 0&) = 0 Then
    Err.Raise 5, , "Internal error."
  Else
    ToUTF8 = b
  End If

End Function
Sub Test()
  Dim s As String
  s = "<?xml version='1.0' encoding='utf-8'?>"
  s = s & ChrW$(&H43F&) & ChrW$(&H440&) & ChrW$(&H43E&) & ChrW$(&H432&) & ChrW$(&H435&) & ChrW$(&H440&) & ChrW$(&H43A&) & ChrW$(&H430&)

  Dim b() As Byte
  b = ToUTF8(s)

  Open "utf-8.txt" For Binary Access Write As #1
  Put #1, , b
  Close #1
End Sub