VBA 使用 UTF-16 输出到文件

Question

我有一个非常复杂的问题，很难正确解释。互联网上有很多关于这个的讨论，但没有一个确定的。任何帮助，或比我更好的解释，非常感谢。

本质上，我只是尝试使用带有 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 编码属性与文件使用的实际编码不同，因此我必须通过打开和打印命令创建一个 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++，创建一个没有 BOM 的 UTF-16 编码文本文件，可以用 XML 数据填充？非常感谢任何帮助！

Answer 1

您关于 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