Clever-Excel-Forum

Hallo zusammen,

ich habe ein Makro, dass mir meine Excel Datei als .csv abspeichert.

Code:
Sub ExportToCSV()

    Dim lastRow As Long

    Dim csvFilePath As Variant

    Dim i As Long, j As Long

    Dim csvData As String

    ' Bestimme die letzte beschriebene Zelle in Spalte A

    lastRow = Sheets("Tabelle2").Cells(Sheets("Tabelle2").Rows.Count, "A").End(xlUp).Row

    ' Abfrage des Speicherorts für die CSV-Datei

    csvFilePath = Application.GetSaveAsFilename(InitialFileName:="Export.csv", FileFilter:="CSV-Dateien (*.csv), *.csv")

    ' Überprüfe, ob der Benutzer eine Datei ausgewählt hat

    If csvFilePath = "Falsch" Then

        MsgBox "Es wurde keine Datei ausgewählt. Der Export wurde abgebrochen.", vbExclamation

        Exit Sub

    End If

    ' Öffne die CSV-Datei zum Schreiben

    Open csvFilePath For Output As #1

    ' Schreibe Daten in die CSV-Datei

    For i = 1 To lastRow

        csvData = ""

        For j = 1 To 6 ' Spalten A bis F

            ' Behandlung kyrillischer Buchstaben in Spalte F

            If j = 6 Then

                csvData = csvData & Replace(Sheets("Tabelle2").Cells(i, j).Value, ChrW(1604), " ") ' Platzhalter ersetzen

            Else

                csvData = csvData & Sheets("Tabelle2").Cells(i, j).Value

            End If

            If j <> 6 Then csvData = csvData & "," ' Komma als Trennzeichen, außer für die letzte Spalte

        Next j

        Print #1, csvData ' Schreibe Datenzeile in die CSV-Datei

    Next i

    ' Schließe die CSV-Datei

    Close #1

    ' Konvertiere die CSV-Datei von ANSI in UTF-8

    KonvertANSI2UTF csvFilePath, "utf-8"

    MsgBox "CSV-Datei wurde erfolgreich exportiert und konvertiert.", vbInformation

End Sub

Sub KonvertANSI2UTF(ByVal filePath As String, ByVal encoding As String)

    Dim sText As String

    ' Dateiinhalt lesen

    Open filePath For Input As #1

    sText = Input$(LOF(1), 1)

    Close #1

    ' Schreiben der Daten in die neue UTF-Datei

    With CreateObject("ADODB.Stream")

        .Type = 2 ' Textmodus

        .Charset = encoding

        .Open

        .WriteText sText

        .SaveToFile Replace(filePath, ".csv", "_utf8.csv"), 2 ' UTF-8 speichern

        .Close

    End With

End Sub

In Spalte F habe ich allerdings Kyrillische Buchstaben.
Egal was ich mache, ich schaffe es einfach nicht diese Kyrillischen Buchstaben richtig zu formatieren. Es kommt immer als Ergebnis "???????? ??????" in der csv Datei.

Kann mir einer von euch helfen?

Hi,

wieso verwendest du nicht einfach den Befehl "Speichern unter" und als Dateiformat dann "CSV UTF-8"?

Falls du es als Makro brauchst, kannst du den Vorgang auch mit dem Makrorekorder aufzeichnen.

Hi,

muss es unbedingt csv sein? Speichere sie als pdf. Wenn Du die Daten wieder nach Excel importieren willst, geht das mit PQ ganz easy und die kyrillischen Buchstaben bleiben kyrillisch

Ich hab mir selber geholfen.
Vielleicht hilft es ja jemandem für die Zukunft:

Code:
Sub ExportToCSV_UTF8()

    Dim fsT As Object

    Dim csvFilePath As Variant

    Dim tmpStr As String

    Dim lRow As Long

    Dim lastRow As Long

    Dim SrcRg As Range

    Dim cellValue As String

    ' Pfad und Name der zu erstellenden Datei

    csvFilePath = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")

    ' Überprüfen, ob eine Auswahl getroffen wurde

    If Selection.Cells.Count > 1 Then

        Set SrcRg = Selection

    Else

        Set SrcRg = Sheets("Tabelle2").Range("A:F")

    End If

    ' Bestimme die letzte beschriebene Zelle in den Spalten A bis F

    lastRow = SrcRg.Find(What:="*", After:=SrcRg.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).row

    ' ADODB.Stream-Objekt erstellen und konfigurieren

    Set fsT = CreateObject("ADODB.Stream")

    fsT.Type = 2                ' Stream-Typ: Text/String

    fsT.Charset = "utf-8"       ' Zeichensatz

    fsT.Open                    ' Stream öffnen

    ' Daten in den temporären String tmpStr schreiben

    For lRow = 1 To lastRow

        tmpStr = ""

        For Each cell In SrcRg.Rows(lRow).Cells

            ' Zellinhalt in Textwert konvertieren und zu tmpStr hinzufügen

            cellValue = CStr(cell.Value)

            tmpStr = tmpStr & cellValue & ","

        Next cell

        ' Letztes Komma entfernen und Zeilenumbruch hinzufügen

        tmpStr = Left(tmpStr, Len(tmpStr) - 1) & vbCrLf

        fsT.WriteText tmpStr        ' Daten schreiben

    Next lRow

    ' Datei speichern und Stream schließen

    fsT.SaveToFile csvFilePath, 2 ' Datei speichern

    fsT.Close

End Sub

DeLaGhetto

HKindler

Ralf A

DeLaGhetto