VBA вывод в файл с использованием UTF-16 - PullRequest
Новая
       77

VBA вывод в файл с использованием UTF-16

3 голосов
/ 01 февраля 2012

У меня очень сложная проблема, которую трудно правильно объяснить. Есть много дискуссий по этому поводу в Интернете, но ничего определенного. Любая помощь или лучшее объяснение, чем у меня, очень приветствуется.

По сути, я просто пытаюсь написать файл XML, используя UTF-16 с VBA.

Если я сделаю это: 

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.

Googling говорит мне, что это означает, что атрибут кодировки xml отличается от фактической кодировки, используемой файлом, поэтому я должен создавать документ utf-8 с помощью команд Open и Print.

Если я сделаю что-то вроде: 

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

затем в конце моего файла появляются забавные символы (BOM), которые приводят к сбою проверки XML .

Если я открываю файл в Notepad ++, удаляю спецификацию и изменяю кодировку на «UCS-2», тогда файл хорошо проверяется со значением кодировки «utf-16» (это означает, что UCS-2 достаточно близок к UTF -16 что это не имеет значения, или что XML способен Switch from current encoding между этими двумя типами.

Мне нужно использовать UTF-16, потому что UTF-8 не охватывает все символы, используемые в презентациях, которые я экспортирую.

Вопрос:

Как мне заставить VBA вести себя как Notepad ++, создавая текстовый файл в кодировке UTF-16 без спецификации, которая может быть заполнена данными XML? ЛЮБАЯ помощь очень ценится!

1 Ответ

5 голосов
/ 01 февраля 2012

Ваша точка зрения о том, что UTF-8 не может хранить все необходимые вам символы, недействительна.
UTF-8 может хранить все символы, определенные в стандарте Unicode.
Единственное отличие состоит в том, что для текстана некоторых языках UTF-8 может занимать больше места для хранения своих кодовых точек, чем, скажем, UTF-16.Верно и обратное: для некоторых других языков, таких как английский, использование UTF-8 экономит пробела.

VB6 и VBA, хотя строки в памяти в Unicode неявно переключаются на ANSI(используя текущую системную кодовую страницу) при выполнении файла IO.Полученный файл НЕ находится в UTF-8.Это ваша текущая системная кодовая страница, которая, как вы можете обнаружить в этой полезной статье , выглядит точно так же, как 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
...