excel - problemas - formato utf-8
¿Puedo exportar datos de Excel con UTF-8 sin BOM? (6)
Exporto datos de Microsoft Excel por Excel Macro (VBScript). Debido a que el archivo es un script lua, lo exporto como UTF-8. La única forma en que puedo hacer UTF-8 en Excel es usar adodb.stream como este
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
Quiero eliminar BOM de Test.lua pero no sé cómo. (Debido a que Test.lua tiene algún texto Unicode, tengo que usar el formato UTF-8).
¿Sabe cómo hacer un archivo UTF-8 sin BOM en un archivo de Excel? Gracias por adelantado.
Algunas posibilidades:
Coloque el texto en el búfer como UTF-8, Tipo = 2, pero luego configure Tipo = 1 (como binario) y escríbalo. Eso podría convencer a ADODB.Stream para que omita la adición de la lista de materiales.
Cree otro búfer, como tipo binario, y use CopyTo para copiar los datos a ese búfer desde un punto después de la lista de materiales.
Lea el archivo nuevamente usando Scripting.FileSystemObject, elimine la lista de materiales, escriba de nuevo
Aquí hay otro truco de eliminación de listas de materiales, de una respuesta que se superpone a su pregunta.
Disculpas por la respuesta tardía, esto es más para otras personas que se encuentran con los Marcadores de Orden de Byte, y las vistas de la página sobre esta pregunta me dicen que su pregunta es relevante para varios problemas relacionados: es sorprendentemente difícil escribir un archivo sin BOM en VBA - incluso algunas de las bibliotecas de flujos comunes depositan una lista de materiales en su salida, ya sea que la haya solicitado o no.
Digo que mi respuesta se "superpone" porque el código a continuación está resolviendo un problema ligeramente diferente: el propósito principal es escribir un archivo de esquema para una carpeta con una colección heterogénea de archivos, pero es un ejemplo práctico de eliminación de BOM y archivo de BOM libre Escrito en uso , y el segmento relevante está claramente marcado.
La funcionalidad clave es que recorremos todos los archivos ''.csv'' en una carpeta, y probamos cada archivo con un mordisco rápido de los primeros cuatro bytes: y solo asumimos la ardua tarea de eliminar el marcador si ver uno
Estamos trabajando con código de manejo de archivos de bajo nivel de la C. primordial. Tenemos que hacerlo, hasta el punto de usar matrices de bytes, porque todo lo que haga en VBA depositará los Marcadores de Orden de Byte incorporados en la estructura de un variable de cadena .
Así que, sin más adodb, aquí está el código:
BOM: código de eliminación para archivos de texto en un archivo 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
El código es más fácil de entender si sabe que una matriz de bytes se puede asignar a una VBA.String, y viceversa. La función BigReplace () es un truco que esquiva algunos de los ineficientes controles de cadena de VBA, especialmente la asignación: encontrará que los archivos grandes causan serios problemas de memoria y rendimiento si lo hace de otra manera.
Si alguien más está luchando con la constante adTypeText, debe incluir la "Biblioteca de objetos Microsoft ActiveX Data Objects 2.5" en Herramientas-> Referencias.
Si prefieres T-SQL nativo en lugar de código externo
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
También tengo el mismo problema: tengo que exportar datos de Excel (Office 2003, VBA6.5) a un archivo codificado en UTF-8. ¡Encontré la respuesta de tu pregunta! Debajo de mi ejemplo, donde también elimino la lista de materiales con el truco # 2 de la respuesta de boost (¡gracias!). No conseguí el trabajo # 1 y nunca probé el # 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
La referencia ADO Stream Object que utilicé.
Editar
Un comentario de rellampec me alertó de que se había eliminado mejor el LF que había descubierto y se agregó al final del archivo mediante el método del usuario272735. He añadido una nueva versión de mi rutina al final.
Post original
Había estado utilizando el método de user272735 con éxito durante un año cuando descubrí que agregaba un LF al final del archivo. No pude notar este LF adicional hasta que hice algunas pruebas muy detalladas, por lo que no es un error importante. Sin embargo, mi última versión descarta que LF en caso de que alguna vez se vuelva importante.
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://.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://.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
Nueva versión de rutina.
Esta versión omite el código para descartar el LF no deseado agregado al final porque evita agregar el LF en primer lugar. He conservado la versión original en caso de que alguien esté interesado en la técnica para eliminar los caracteres finales.
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://.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
'' 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://.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