captnhowdy
Goto Top

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

Content-Key: 1481772554

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

Printed on: April 19, 2024 at 06:04 o'clock

Member: SachsenHessi
SachsenHessi Nov 08, 2021 at 09:00:37 (UTC)
Goto Top
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
Mitglied: 149569
149569 Nov 08, 2021 updated at 10:02:26 (UTC)
Goto Top
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.
Member: CaptnHowdy
CaptnHowdy Nov 08, 2021 at 12:51:47 (UTC)
Goto Top
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!
123
Mitglied: 149569
149569 Nov 08, 2021 updated at 13:58:05 (UTC)
Goto Top
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
Member: CaptnHowdy
CaptnHowdy Nov 08, 2021 at 14:58:24 (UTC)
Goto Top
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 face-smile
Mitglied: 149569
149569 Nov 08, 2021 updated at 16:20:12 (UTC)
Goto Top
Zitat von @CaptnHowdy:
Ich bin blutiger Anfänger.
Na das lässt sich schnell ändern Excel VBA Tutorial for Beginners: Learn in 3 Days
Member: CaptnHowdy
CaptnHowdy Nov 19, 2021 at 07:51:28 (UTC)
Goto Top
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