Могу ли я экспортировать данные Excel с UTF-8 без спецификации? - PullRequest
22 голосов
/ 10 ноября 2010

Я экспортирую данные Microsoft Excel с помощью Excel Macro (VBScript).Поскольку файл представляет собой скрипт lua, я экспортирую его как UTF-8.Единственный способ сделать UTF-8 в Excel - это использовать adodb.stream следующим образом:

set fileLua = CreateObject("adodb.stream")
fileLua.Type = 2
fileLua.Mode = 3
fileLua.Charset = "UTF-8"
fileLua.Open
fileLua.WriteText("test")
fileLua.SaveToFile("Test.lua")
fileLua.flush
fileLua.Close

Я хочу исключить спецификацию из Test.lua, но не знаю как.(Поскольку в Test.lua есть какой-то текст в юникоде, я должен использовать формат UTF-8.)

Знаете ли вы, как сделать файл UTF-8 без спецификации в файле Excel?Заранее спасибо.

Ответы [ 6 ]

32 голосов
/ 16 декабря 2010

У меня тоже та же проблема: приходится экспортировать данные из Excel (Office 2003, VBA6.5) в файл в кодировке UTF-8. Нашел ответ по вашему вопросу! Ниже моего примера, где я также раздеваю спецификацию, используя трюк № 2 из ответа Boos (спасибо!). Я не работал # 1 и никогда не пытался # 3.

Sub WriteUTF8WithoutBOM()
    Dim UTFStream As Object
    Set UTFStream = CreateObject("adodb.stream")
    UTFStream.Type = adTypeText
    UTFStream.Mode = adModeReadWrite
    UTFStream.Charset = "UTF-8"
    UTFStream.LineSeparator = adLF
    UTFStream.Open
    UTFStream.WriteText "This is an unicode/UTF-8 test.", adWriteLine
    UTFStream.WriteText "First set of special characters: öäåñüûú€", adWriteLine
    UTFStream.WriteText "Second set of special characters: qwertzuiopõúasdfghjkléáûyxcvbnm\|Ä€Í÷×äðÐ[]í³£;?¤>#&@{}<;>*~¡^¢°²`ÿ´½¨¸0", adWriteLine

    UTFStream.Position = 3 'skip BOM

    Dim BinaryStream As Object
    Set BinaryStream = CreateObject("adodb.stream")
    BinaryStream.Type = adTypeBinary
    BinaryStream.Mode = adModeReadWrite
    BinaryStream.Open

    'Strips BOM (first 3 bytes)
    UTFStream.CopyTo BinaryStream

    'UTFStream.SaveToFile "d:\adodb-stream1.txt", adSaveCreateOverWrite
    UTFStream.Flush
    UTFStream.Close

    BinaryStream.SaveToFile "d:\adodb-stream2.txt", adSaveCreateOverWrite
    BinaryStream.Flush
    BinaryStream.Close
End Sub

Ссылка Объект потока ADO Я использовал.

9 голосов
/ 21 июля 2011

Если кто-то еще борется с константой adTypeText, вам нужно включить «Библиотеку объектов Microsoft ActiveX Data Objects 2.5» в меню «Инструменты-> Ссылки».

7 голосов
/ 15 ноября 2010

Несколько возможностей:

  1. Поместите текст в буфер как UTF-8, Type = 2, но затем установите Type = 1 (в двоичном виде) и запишите его.Это может убедить ADODB.Stream пропустить добавление спецификации.

  2. Создайте другой буфер, как двоичный тип, и используйте CopyTo для копирования данных в этот буфер из точки после спецификации.

  3. Считайте файл еще раз, используя Scripting.FileSystemObject, обрежьте спецификацию, запишите снова

1 голос
/ 11 октября 2017

Редактировать

Комментарий от rellampec предупредил меня о том, что лучше отбросить обнаруженный мной НЧ был добавлен в конец файла методом user272735. В конце я добавил новую версию своей программы.

Оригинальный пост

Я успешно использовал метод user272735 в течение года, когда обнаружил, что в конце файла добавлен LF. Я не замечал этот дополнительный LF, пока не провел очень подробное тестирование, так что это не является важной ошибкой. Однако моя последняя версия отказывается от этого LF на тот случай, если он когда-нибудь станет важным.

Public Sub PutTextFileUtf8(ByVal PathFileName As String, ByVal FileBody As String)

  ' Outputs FileBody as a text file (UTF-8 encoding without leading BOM)
  ' named PathFileName

  ' Needs reference to "Microsoft ActiveX Data Objects n.n Library"
  ' Addition to original code says version 2.5. Tested with version 6.1.

  '  1Nov16  Copied from http://stackoverflow.com/a/4461250/973283
  '          but replaced literals with parameters.
  ' 15Aug17  Discovered routine was adding an LF to the end of the file.
  '          Added code to discard that LF.

  ' References: http://stackoverflow.com/a/4461250/973283
  '             https://www.w3schools.com/asp/ado_ref_stream.asp

  Dim BinaryStream As Object
  Dim UTFStream As Object

  Set UTFStream = CreateObject("adodb.stream")

  UTFStream.Type = adTypeText
  UTFStream.Mode = adModeReadWrite
  UTFStream.Charset = "UTF-8"
  ' The LineSeparator will be added to the end of FileBody. It is possible
  ' to select a different value for LineSeparator but I can find nothing to
  ' suggest it is possible to not add anything to the end of FileBody
  UTFStream.LineSeparator = adLF
  UTFStream.Open
  UTFStream.WriteText FileBody, adWriteLine

  UTFStream.Position = 3 'skip BOM

  Set BinaryStream = CreateObject("adodb.stream")
  BinaryStream.Type = adTypeBinary
  BinaryStream.Mode = adModeReadWrite
  BinaryStream.Open

  UTFStream.CopyTo BinaryStream

  ' Oriinally I planned to use "CopyTo Dest, NumChars" to not copy the last
  ' byte.  However, NumChars is described as an integer whereas Position is
  ' described as Long. I was concerned by "integer" they mean 16 bits.
  'Debug.Print BinaryStream.Position
  BinaryStream.Position = BinaryStream.Position - 1
  BinaryStream.SetEOS
  'Debug.Print BinaryStream.Position

  UTFStream.Flush
  UTFStream.Close
  Set UTFStream = Nothing

  BinaryStream.SaveToFile PathFileName, adSaveCreateOverWrite
  BinaryStream.Flush
  BinaryStream.Close
  Set BinaryStream = Nothing

End Sub

Новая версия подпрограммы

Эта версия не содержит код для удаления ненужного LF, добавленного в конце, потому что в первую очередь избегает добавления LF. Я сохранил оригинальную версию на тот случай, если кто-нибудь заинтересуется техникой удаления завершающих символов.

Public Sub PutTextFileUtf8NoBOM(ByVal PathFileName As String, ByVal FileBody As String)

  ' Outputs FileBody as a text file named PathFileName using
  ' UTF-8 encoding without leading BOM

  ' Needs reference to "Microsoft ActiveX Data Objects n.n Library"
  ' Addition to original code says version 2.5. Tested with version 6.1.

  '  1Nov16  Copied from http://stackoverflow.com/a/4461250/973283
  '          but replaced literals with parameters.
  ' 15Aug17  Discovered routine was adding an LF to the end of the file.
  '          Added code to discard that LF.
  ' 11Oct17  Posted to StackOverflow
  '  9Aug18  Comment from rellampec suggested removal of adWriteLine from
  '          WriteTest statement would avoid adding LF.
  ' 30Sep18  Amended routine to remove adWriteLine from WriteTest statement
  '          and code to remove LF from file. Successfully tested new version.

  ' References: http://stackoverflow.com/a/4461250/973283
  '             https://www.w3schools.com/asp/ado_ref_stream.asp

  Dim BinaryStream As Object
  Dim UTFStream As Object

  Set UTFStream = CreateObject("adodb.stream")

  UTFStream.Type = adTypeText
  UTFStream.Mode = adModeReadWrite
  UTFStream.Charset = "UTF-8"
  UTFStream.Open
  UTFStream.WriteText FileBody

  UTFStream.Position = 3 'skip BOM

  Set BinaryStream = CreateObject("adodb.stream")
  BinaryStream.Type = adTypeBinary
  BinaryStream.Mode = adModeReadWrite
  BinaryStream.Open

  UTFStream.CopyTo BinaryStream

  UTFStream.Flush
  UTFStream.Close
  Set UTFStream = Nothing

  BinaryStream.SaveToFile PathFileName, adSaveCreateOverWrite
  BinaryStream.Flush
  BinaryStream.Close
  Set BinaryStream = Nothing

End Sub
0 голосов
/ 08 декабря 2016

Вот еще один взлом BOM, из ответа, который перекрывает ваш вопрос.

Извините за поздний ответ - это больше для других людей, которые сталкиваются с маркерами порядка байтов - и просмотры страниц по этому вопросу говорят мне, что ваш вопрос имеет отношение к нескольким связанным проблемам: на удивление трудно написать BOM-Free файл в VBA - даже некоторые библиотеки общих потоков вносят BOM в ваш вывод, независимо от того, просили вы об этом или нет.

Я говорю, что мой ответ «перекрывается», потому что приведенный ниже код решает немного другую проблему - основная цель - написание файла схемы для папки с разнородным набором файлов - но это рабочий пример удаления спецификации и спецификации -свободная запись файла используется , и соответствующий сегмент четко обозначен.

Ключевая функциональность заключается в том, что мы перебираем все файлы '.csv' в папке и тестируем каждый файл с быстрым откусыванием первых четырех байтов: и мы только беремся за тягостную задачу удаления маркер, если мы увидим один.

Мы работаем с низкоуровневым кодом для обработки файлов из первичного языка C. Мы должны, вплоть до использования байтовых массивов, потому что все остальное, что вы делаете в VBA, будет вносить маркеры порядка байтов встраивается в структуру строковой переменной .

Итак, без дополнительного adodb, вот код:

Код утилизации для текстовых файлов в файле schema.ini:

Public Sub SetSchema(strFolder As String)
On Error Resume Next 
' Write a Schema.ini file to the data folder.
' This is necessary if we do not have the registry privileges to set the ' correct 'ImportMixedTypes=Text' registry value, which overrides IMEX=1
' The code also checks for ANSI or UTF-8 and UTF-16 files, and applies a ' usable setting for CharacterSet ( UNICODE|ANSI ) with a horrible hack.
' OEM codepage-defined text is not supported: further coding is required
' ...And we strip out Byte Order Markers, if we see them - the OLEDB SQL ' provider for textfiles can't deal with a BOM in a UTF-16 or UTF-8 file
' Not implemented: handling tab-delimited files or other delimiters. The ' code assumes a header row with columns, specifies 'scan all rows', and ' imposes 'read the column as text' if the data types are mixed.
Dim strSchema As String Dim strFile As String Dim hndFile As Long Dim arrFile() As Byte Dim arrBytes(0 To 4) As Byte
If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
' Dir() is an iterator function when you call it with a wildcard:
strFile = VBA.FileSystem.Dir(strFolder & "*.csv")
Do While Len(strFile) > 0
hndFile = FreeFile Open strFolder & strFile For Binary As #hndFile Get #hndFile, , arrBytes Close #hndFile
strSchema = strSchema & "[" & strFile & "]" & vbCrLf strSchema = strSchema & "Format=CSVDelimited" & vbCrLf strSchema = strSchema & "ImportMixedTypes=Text" & vbCrLf strSchema = strSchema & "MaxScanRows=0" & vbCrLf
If arrBytes(2) = 0 Or arrBytes(3) = 0 Then ' this is a hack strSchema = strSchema & "CharacterSet=UNICODE" & vbCrLf Else strSchema = strSchema & "CharacterSet=ANSI" & vbCrLf End If
strSchema = strSchema & "ColNameHeader = True" & vbCrLf strSchema = strSchema & vbCrLf
' ***********************************************************
' BOM disposal - Byte order marks break the Access OLEDB text provider:
If arrBytes(0) = &HFE And arrBytes(1) = &HFF _ Or arrBytes(0) = &HFF And arrBytes(1) = &HFE Then
hndFile = FreeFile Open strFolder & strFile For Binary As #hndFile ReDim arrFile(0 To LOF(hndFile) - 1) Get #hndFile, , arrFile Close #hndFile
BigReplace arrFile, arrBytes(0) & arrBytes(1), ""
hndFile = FreeFile Open strFolder & strFile For Binary As #hndFile Put #hndFile, , arrFile Close #hndFile Erase arrFile
ElseIf arrBytes(0) = &HEF And arrBytes(1) = &HBB And arrBytes(2) = &HBF Then
hndFile = FreeFile Open strFolder & strFile For Binary As #hndFile ReDim arrFile(0 To LOF(hndFile) - 1) Get #hndFile, , arrFile Close #hndFile BigReplace arrFile, arrBytes(0) & arrBytes(1) & arrBytes(2), ""
hndFile = FreeFile Open strFolder & strFile For Binary As #hndFile Put #hndFile, , arrFile Close #hndFile Erase arrFile
End If
' ***********************************************************

strFile = "" strFile = Dir
Loop
If Len(strSchema) > 0 Then
strFile = strFolder & "Schema.ini"
hndFile = FreeFile Open strFile For Binary As #hndFile Put #hndFile, , strSchema Close #hndFile
End If

End Sub

Public Sub BigReplace(ByRef arrBytes() As Byte, _ ByRef SearchFor As String, _ ByRef ReplaceWith As String) On Error Resume Next
Dim varSplit As Variant
varSplit = Split(arrBytes, SearchFor) arrBytes = Join$(varSplit, ReplaceWith)
Erase varSplit
End Sub

Код легче понять, если вы знаете, что байтовый массив может быть назначен для VBA.String и наоборот. Функция BigReplace () - это хак, который обходит неэффективную обработку строк в VBA, особенно распределение: вы обнаружите, что большие файлы вызывают серьезные проблемы с памятью и производительностью, если вы делаете это любым другим способом.

0 голосов
/ 26 мая 2015

Если вы предпочитаете собственный T-SQL вместо внешнего кода

DECLARE @FILE_NAME              VARCHAR(255)    = 'd:\utils\test.xml'       --drive:\path\filename\
DECLARE @FILE_DATA              VARCHAR(MAX)    = '<?xml version="1.0" encoding="UTF-8"?>test</xml>'            --binary as varchar(max)

DECLARE @FILE_NAME_TO           VARCHAR(255)                        --Temp name for text stream
DECLARE @FSO_ID_TXTSTRM         INT                                 --Text Stream
DECLARE @FSO_ID_BINSTRM         INT                                 --Binary Stream
DECLARE @RC                     INT 

EXEC @RC = sp_OACreate 'ADODB.Stream',  @FSO_ID_TXTSTRM OUTPUT
EXEC @RC = sp_OASetProperty             @FSO_ID_TXTSTRM,    'Type',             2                           --1 = binary, 2 = text
EXEC @RC = sp_OASetProperty             @FSO_ID_TXTSTRM,    'Mode',             3                           --0 = not set, 1 read, 2 write, 3 read/write
EXEC @RC = sp_OASetProperty             @FSO_ID_TXTSTRM,    'Charset',          'UTF-8'                     --'ISO-8859-1'
EXEC @RC = sp_OASetProperty             @FSO_ID_TXTSTRM,    'LineSeparator',    'adLF'
EXEC @RC = sp_OAMethod                  @FSO_ID_TXTSTRM,    'Open'  
EXEC @RC = sp_OAMethod                  @FSO_ID_TXTSTRM,    'WriteText',        NULL,       @FILE_DATA      --text method

--Create binary stream
EXEC @RC = sp_OACreate 'ADODB.Stream',  @FSO_ID_BINSTRM OUTPUT
EXEC @RC = sp_OASetProperty             @FSO_ID_BINSTRM,    'Type',             1                           --1 = binary, 2 = text
EXEC @RC = sp_OAMethod                  @FSO_ID_BINSTRM,    'Open'
EXEC @RC = sp_OASetProperty             @FSO_ID_BINSTRM,    'Mode',             3                           --0 = not set, 1 read, 2 write, 3 read/write    

--Move 3 positions forward in text stream (BOM is first 3 positions)
EXEC @RC = sp_OASetProperty             @FSO_ID_TXTSTRM,    'Position',         3

--Copy text stream to binary stream
EXEC @RC = sp_OAMethod                  @FSO_ID_TXTSTRM,    'CopyTo',           NULL,       @FSO_ID_BINSTRM

--Commit data and close text stream
EXEC @RC = sp_OAMethod                  @FSO_ID_TXTSTRM,    'Flush'
EXEC @RC = sp_OAMethod                  @FSO_ID_TXTSTRM,    'Close'
EXEC @RC = sp_OADestroy                 @FSO_ID_TXTSTRM

--Save binary stream to file and close
EXEC @RC = sp_OAMethod                  @FSO_ID_BINSTRM,    'SaveToFile',       NULL,       @FILE_NAME, 2   --1 = notexist 2 = overwrite
EXEC @RC = sp_OAMethod                  @FSO_ID_BINSTRM,    'Close'
EXEC @RC = sp_OADestroy                 @FSO_ID_BINSTRM
...