Office: UTF-8 ohne BOM

fabian86 · 25. Mai 2018

Ich habe mir eine Musterdatei angelegt welche ich per Schleiffe ändere und Speichere, dies geht einwandfrei, leider werden die Files in UTF-8-BOM Gespeichert, das Programm Programm wo ich es dann einlese kommt leider nicht damit klar...
Was muss man ändern das die Files in UTF-8 ohne BOM gespeichert werden?

Code:

Public Sub import()
Dim Datei, iFile
Dim objStream, strData
Dim Spalte As Long
Dim strPfad As String
Dim strDatei As String
Dim strOrdner As String
Dim strEndung As String
Dim Auftragnummer As String
Dim intr1 As Integer, intr2 As Integer, Suchspalte As Integer

Spalte = 2
strPfad = Range("J1")
strEndung = Range("J2")
strOrdner = "" & Range("J3") & ""

'Prüfen ob Ordner da ist wenn nicht erzeugen
If Dir(strPfad & strOrdner, vbDirectory) = "" Then
MkDir (strPfad & strOrdner)
End If

'Prüfen ob Text 2x vorkommt

Suchspalte = 4
For intr1 = 1 To Cells(Rows.Count, 4).End(xlUp).Row
For intr2 = intr1 + 1 To Cells(Rows.Count, 4).End(xlUp).Row
If Cells(intr1, Suchspalte) = Cells(intr2, Suchspalte) Then
MsgBox Cells(intr1, Suchspalte).Value & " ist doppelt vorhanden (Zeile" & intr1 & " und " & intr2 & " Es werden keine Dateien erzeugt, da diese sonst überschrieben werden! Bitte Doppelte Einträge korrigieren!"
Exit Sub
End If
Next intr2
Next intr1

Do While Cells(Spalte, 1).Value ""
strDatei = Range("D" & Spalte)

'Textdatei auslesen
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
objStream.LoadFromFile ("E:Eigene Dateienmuster.GEO")
strData = objStream.ReadText()

'Suchen und ersetzen
strData = Replace(strData, "laenge", Range("A" & Spalte))

strData = Replace(strData, "breite", Range("B" & Spalte))

strData = Replace(strData, "anzahll", Range("E" & Spalte))

strData = Replace(strData, "lochx", Range("F" & Spalte))

strData = Replace(strData, "lochy", Range("G" & Spalte))

strData = Replace(strData, "mmquad", Range("C" & Spalte))

'Speichern
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
objStream.WriteText strData
objStream.SaveToFile strPfad & strOrdner & strDatei & strEndung, 2
objStream.Close

Spalte = Spalte + 1
Loop
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Falls jemand noch einen Fehler entdeckt oder einen Hinweis wie es einfacher geht wäre ich Dankbar, da ich VBA neuling bin...

:)

daolix · 27. Mai 2018

Hallo
versuch

Code:

Sub SaveasUTF8(ByVal sText As String, ByVal sFile As String, Optional WithoutBom As Boolean)
Dim binstrm As Object
With CreateObject("ADODB.Stream")
.Charset = "utf-8"
.Open
.WriteText sText
If WithoutBom Then
Set binstrm = CreateObject("ADODB.Stream")
binstrm.Type = adTypeBinary
binstrm.Open
.Position = 3
.CopyTo binstrm
binstrm.SaveToFile sFile, 2
Else
.SaveToFile sFile, 2
End If
.Close
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

aufruf in deiner Fnkt ist dann
Code:

SaveasUTF8 strData, strPfad & strOrdner & strDatei & strEndung, true
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

fabian86 · 28. Mai 2018

Da kommt bei mir ein Laufzeitfehler 3001

Die Argumente sind vom Falschen Typ, liegen ausserhalt des Gültikeitsbereicht oder sind miteinander unvereinbar.

daolix · 28. Mai 2018

ersetz in der angezeigten Zeile adTypeBinary durch 1.

fabian86 · 28. Mai 2018

Super jetzt gehts! Danke dir vielmals!

Office: UTF-8 ohne BOM

UTF-8 ohne BOM

UTF-8 ohne BOM

UTF-8 ohne BOM

UTF-8 ohne BOM - Similar Threads - UTF BOM

Export als Textdatei in UTF-8

Excel wandelt Datum um nach Abspeichern als UTF-8 csv Format

Export als Unicode UTF-8 speichern

Export als UTF-8 csv

XML Datei als UTF-8 speicher

Textdatei als utf-8 abspeichern

Word 2013 UTF 16