08.11.2021, aktualisiert um 09:09:29 Uhr

7654

EXCEL Export (VBA) zu CSV - falsche Codierung (Soll: UTF-8 Codierung)

Hallo zusammen,

ich habe ein Excel Tabellenblatt welches ich mittels VBA zu einer CSV exportiere.
Leider bemängelt mein Dienstleister nun die Codierung.
Note++ zeigt die CSV Datei als "ANSI" Codierung an was wohl bei der Verarbeitung zu Problemen führt.

Kann mir bitte jemand sagen, wie ich mein Script ändern muss, damit eine UTF-8 Codierung direkt berücksichtigt wird?

Sub Stammdaten_Aktuell_Export()
  Dim varSpalten
  Dim intSpalte As Integer, lngZeile As Long
  Dim objQuellblatt As Worksheet
  Dim objZielblatt As Worksheet
  Dim strPfad As String
  Dim varTmp, strOut, strOutZwischen As String
  Open "c:\Stammdaten_BAV_Portal\Stammdaten_Aktuell.csv" For Output As #1  'Datenquelle festlegen  
  Set objQuellblatt = ThisWorkbook.Sheets("Stammdaten_Aktuell") 'Tabellenblatt festlegen  

  varSpalten = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21) 'Spalten die Exportiert werden  
  varTmp = objQuellblatt.UsedRange
  For lngZeile = 1 To UBound(varTmp)
    strOut = ""  
    If Len(varTmp(lngZeile, varSpalten(0))) > 0 Then
      For intSpalte = 0 To UBound(varSpalten)

        Select Case varSpalten(intSpalte)

          Case 1, 2, 9: strOutZwischen = Format(varTmp(lngZeile, varSpalten(intSpalte)), "0000000#") 'Format mit Nullen auffüllen  

          Case 14, 18: strOutZwischen = Format(varTmp(lngZeile, varSpalten(intSpalte)), "000#") 'Format mit Nullen auffüllen  
          Case 12: strOutZwischen = Format(varTmp(lngZeile, varSpalten(intSpalte)), "0000#") 'Format mit Nullen auffüllen  
          Case 16: strOutZwischen = Format(varTmp(lngZeile, varSpalten(intSpalte)), "0.0")  'Format mit Nullen auffüllen bzw trennen mit Komma  
          Case 21: strOutZwischen = Format(varTmp(lngZeile, varSpalten(intSpalte)), "0#") 'Format mit Nullen auffüllen  
         
          Case Else: strOutZwischen = varTmp(lngZeile, varSpalten(intSpalte))

        End Select

        strOut = strOut & ";" & strOutZwischen  

      Next intSpalte

      strOut = Mid(strOut, 2)
      Print #1, strOut
    End If
  Next lngZeile
  Close #1

End Sub

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 1481772554

Url: https://administrator.de/contentid/1481772554

Ausgedruckt am: 16.11.2024 um 03:11 Uhr

7 Kommentare

Neuester Kommentar

Hallo,

With ActiveWorkbook.WebOptions
        .RelyOnCSS = True
        .OrganizeInFolder = True
        .UseLongFileNames = True
        .DownloadComponents = False
        .RelyOnVML = False
        .AllowPNG = True
        .ScreenSize = msoScreenSize1024x768
        .PixelsPerInch = 96
        .Encoding = msoEncodingUTF8
    End With
    With Application.DefaultWebOptions
        .SaveHiddenData = True
        .LoadPictures = True
        .UpdateLinksOnSave = True
        .CheckIfOfficeIsHTMLEditor = True
        .AlwaysSaveInDefaultEncoding = False
        .SaveNewWebPagesAsWebArchives = True
    End With
    ChDir "C:\"  
    ActiveWorkbook.SaveAs FileName:= _
        "c:\Mappe2.xlsx", FileFormat _  
        :=xlOpenXMLWorkbook, CreateBackup:=False

(Code ungetestet)

oder händisch https://blog.soprani.at/2017/02/23/csv-datei-im-format-utf-8-speichern/

VG
SH

Kann mir bitte jemand sagen, wie ich mein Script ändern muss, damit eine UTF-8 Codierung direkt berücksichtigt wird?

Wie man UTF-8 Dateiinhalte weg schreibt kannst du hier nachlesen
VBS entfernen von "Grad" Zeichen in TXT Datei
Einfach die Funktion übernehmen und damit deine Text-Variable weg schreiben.

Zitat von @149569:

Kann mir bitte jemand sagen, wie ich mein Script ändern muss, damit eine UTF-8 Codierung direkt berücksichtigt wird?

Wie man UTF-8 Dateiinhalte weg schreibt kannst du hier nachlesen
VBS entfernen von "Grad" Zeichen in TXT Datei
Einfach die Funktion übernehmen und damit deine Text-Variable weg schreiben.

Dankeschön. Aber ich weiß jetzt nicht
--> ob ich den ganzen Code einfügen soll / kann, oder nur das blau markierte
--> wo muss ich denk Code einfügen

Sorry und Danke Euch für die Unterstützung!

Zitat von @CaptnHowdy:
Dankeschön. Aber ich weiß jetzt nicht
--> ob ich den ganzen Code einfügen soll / kann, oder nur das blau markierte

Echt jetzt? Schon wieder Freitag ? Wie die der Funktionsname doch schon sagt brauchst du nur die Funktion zum Schreiben von UTF-8 Dateien (also WriteUTF8) du willst ja nichts auslesen! Das Ding da auf deinem Hals hat auch eine Funktion, also nutzen!

--> wo muss ich denk Code einfügen

Na, wo gehören weitere Funktion hin? Natürlich nicht in deine jetzige Funktion sondern außerhalb.
Für den Aufruf siehst du ja das Beispiel in der letzten Zeile. Also lesen, verstehen und dann anwenden. Copy n Paste bringt dich nicht weiter.

Sorry und Danke Euch für die Unterstützung!

Bitte, gerne.

Sub Stammdaten_Aktuell_Export()
      ' .......  
      ' ....  
      WriteUTF8 "c:\Stammdaten_BAV_Portal\Stammdaten_Aktuell.csv", strOut  
    End If
  Next lngZeile
End Sub

Sub WriteUTF8(file, txt)
  With CreateObject("ADODB.Stream")  
  	.Type = 2 : .Charset = "UTF-8" : .Open  
  	.WriteText txt
  	.SaveToFile file, 2
  	.Close
  End With
End Sub

Diese Zeilen hier brauchst du dann natürlich nicht mehr, das übernimmt alles die Subroutine WriteUTF8, also weg damit ...

Open "c:\Stammdaten_BAV_Portal\Stammdaten_Aktuell.csv" For Output As #1  'Datenquelle festlegen  
Print #1, strOut
Close #1

Dankeschön, ich bekomme es zwar nicht zum laufen, aber ich versuche es weiter. Ich bin blutiger Anfänger.

Sehen und verstehen ist da nicht so einfach wenn man nicht weiß was man tut

Zitat von @CaptnHowdy:
Ich bin blutiger Anfänger.

Na das lässt sich schnell ändern Excel VBA Tutorial for Beginners: Learn in 3 Days

Zitat von @SachsenHessi:

Hallo,

With ActiveWorkbook.WebOptions
>         .RelyOnCSS = True
>         .OrganizeInFolder = True
>         .UseLongFileNames = True
>         .DownloadComponents = False
>         .RelyOnVML = False
>         .AllowPNG = True
>         .ScreenSize = msoScreenSize1024x768
>         .PixelsPerInch = 96
>         .Encoding = msoEncodingUTF8
>     End With
>     With Application.DefaultWebOptions
>         .SaveHiddenData = True
>         .LoadPictures = True
>         .UpdateLinksOnSave = True
>         .CheckIfOfficeIsHTMLEditor = True
>         .AlwaysSaveInDefaultEncoding = False
>         .SaveNewWebPagesAsWebArchives = True
>     End With
>     ChDir "C:\"  
>     ActiveWorkbook.SaveAs FileName:= _
>         "c:\Mappe2.xlsx", FileFormat _  
>         :=xlOpenXMLWorkbook, CreateBackup:=False

(Code ungetestet)

oder händisch https://blog.soprani.at/2017/02/23/csv-datei-im-format-utf-8-speichern/

VG
SH

Leider funktioniert die Variante nicht - Nur für Websites

Frage Datenbanken Entwicklung

Mehr von CaptnHowdy

VBA in Excel - suche eindeutigen Wert und lösche Zeile VON-BISCaptnHowdy - 1 Kommentar

Excel VBA entfernt führende Nullen beim Export zu CSVCaptnHowdy - 1 Kommentar

Suchen einen bzw. mehrere Werte und ersetzt -VBA durch InhaltCaptnHowdy - 6 Kommentare

VBA - in Prüfung von unten nach oben umwandelCaptnHowdy - 2 Kommentare

Heiß diskutiert