Puis-je exporter des données excel avec UTF-8 sans BOM?

quelques possibilités:

1. mettez le texte dans le buffer comme UTF-8, Type=2, mais ensuite mettez Type=1 (en binaire) et écrivez cela. Ça pourrait convaincre ADODB.Flux d'ignorer l'ajout de la NOMENCLATURE.

2. créer un autre buffer, comme type binaire, et utiliser le CopyTo pour copier les données dans ce buffer à partir d'un point après le BOM.

3. Lire le fichier en utilisant de nouveau L'écriture de scripts.FileSystemObject, couper le BOM, écrire à nouveau

si quelqu'un d'autre est aux prises avec la constante adTypeText, vous devez inclure" Microsoft ActiveX Data Objects 2.5 Object Library " sous Outils->Références.

Uf vous préférez T-SQL natif au lieu de code externe

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

voici un autre piratage de Bom-disposal, d'une réponse qui chevauche votre question.

mes excuses pour la réponse tardive - c'est plus pour les autres personnes qui rencontrent des marqueurs D'ordre D'octet - et les pages vues sur cette question me disent que votre question est pertinente à plusieurs problèmes connexes: Il est étonnamment difficile d'écrire un fichier sans BOM dans VBA-même certains des courants bibliothèques déposent un BOM dans votre sortie, que vous l'ayez demandé ou non.

je dis que ma réponse" chevauche "parce que le code ci - dessous résout un problème légèrement différent - le but principal est d'écrire un fichier de schéma pour un dossier avec un ensemble hétérogène de fichiers-mais c'est un exemple de travail de suppression de BOM et d'écriture de fichier sans BOM en usage , et le segment pertinent est clairement marqué.

la fonctionnalité clé est que nous itérons à travers tout le '.csv les fichiers dans un dossier, et nous testons chaque fichier avec un rapide grignoter des quatre premiers octets: et nous avons seulement d'entreprendre la lourde tâche d'éliminer un marqueur si nous voyons un.

nous travaillons avec le code de traitement de fichier de bas niveau du C. primordial nous devons, jusqu'à utiliser des tableaux d'octets, parce que tout le reste que vous faites dans VBA va déposer les marqueurs D'ordre D'octets inclus dans la structure d'une variable de chaîne .

donc, sans plus attendre, voici le code:

NOMENCLATURE de l'Élimination de code pour les fichiers texte dans un schéma.fichier 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

le code est plus facile à comprendre si vous savez qu'un tableau D'octets peut être assigné à une VBA.String, et vice versa. La fonction BigReplace () est un hack qui évite à VBA de gérer des chaînes de caractères inefficaces, en particulier l'allocation: vous constaterez que les gros fichiers causent de graves problèmes de mémoire et de performance si vous le faites de toute autre manière.

Modifier

un commentaire de rellampec m'a alerté à un mieux de laisser tomber le si j'avais découvert a été ajouté à la fin du dossier par la méthode de user272735. J'ai ajouté une nouvelle version de ma routine à la fin.

post Original

j'utilisais avec succès la méthode user272735 depuis un an quand j'ai découvert qu'elle ajoutait un LF à la fin du fichier. Je n'ai pas d'avis ce LF supplémentaire jusqu'à ce que j'ai fait quelques tests très détaillés de sorte que ce n'est pas une erreur importante. Cependant, ma dernière version écarte que si juste au cas où il est devenu important.

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

nouvelle version de routine

cette version omet le code pour rejeter le LF non désiré ajouté à la fin parce qu'il évite d'ajouter le LF en premier lieu. J'ai gardé la version originale au cas où quelqu'un s'intéresserait à la technique pour supprimer des caractères de fin.

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