Nutzen Sie unser 
Dieses Beispiel zeigt, wie CSV-Dateien mit UniCode-Zeichen erzeugt werden können. Im Standardzeichensatz können in ASCII-Dateien, also auch in CSV-Dateien z. B. keine chinesischen Zeichen ausgegeben werden. Mit Hilfe des folgenden VBA-Codes können hingegen auch Zeichen ausserhalb des ASCII-Satzes, also auch Sonderzeichen ect. ausgeben. Mehr über den UniCode-Zeichensatz finden Sie hier bei Wikipedia.de.
Erfassen Sie den folgenden VBA-Code (drei Prozeduren) in einem neuen Code-Modul. Aufgerufen wird der Export über die erste Prozedur "UniCode_CSV_erzeugen". Im Beispiel wird die erzeugte UniCode CSV-Datei im gleichen Verzeichnis abgelegt, wie die Excel-Datei aus der die CSV-Datei erzeugt werden soll.
Die Ausgangsdatei enthält drei Spalten, in der dritten Spalte befinden sich chinesische Zeichen, die in die CSV-Datei übertragen werden sollen, siehe Abbildung:
VBA-Code zur Erzeugung von Unicode CSV-Dateien:
Sub UniCode_CSV_erzeugen()
'** Dimensionierung der Variablen
Dim strFile As Variant
'** Dateiname + Pfad festlegen
'strFile = Application.GetSaveAsFilename("Unicode_CSV-Datei.csv", "CSV-Dateien,*.csv,Alle Dateien,*.*")
strFile = ThisWorkbook.Path & "\Unicode-CSV-Datei.csv"
'** Beenden, wenn kein Dateiname vorhanden ist
If strFile = False Then Exit Sub
'** Speicher-Prozedur aufrufen
Code_CSV_speichern (strFile)
End Sub
Sub Code_CSV_speichern(strFile As String)
'** Dimensionierung der Variablen
Dim filenr, a, b, lngAnzSp As Integer
Dim strData As String '** CSV-Datenzeile
'** Vorgaben definieren
filenr = FreeFile
lngAnzSp = ThisWorkbook.Sheets("Daten").Cells.SpecialCells(xlCellTypeLastCell).Column
'** Datei öffnen
Open strFile For Output As #filenr
'** Daten in CSV-Datei schreiben
Print #filenr, Chr(255); Chr(254);
For a = 1 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
strData = ""
For b = 1 To lngAnzSp - 1
strData = strData & Cells(a, b).Text & ";"
Next b
strData = strData & Cells(a, b).Text & vbCrLf
Print #filenr, GetUniCodeString(strData);
Next a
'** Datei schließen
Close #filenr
End Sub
Private Function GetUniCodeString(s As String) As String
'** Dimensionierung der Variablen
Dim a As Integer ' Zähler über die einzelnen Bytes des Unicode-Strings
'** Umwanden in Unicode-Zeichen
GetUniCodeString = ""
For a = 1 To LenB(s)
GetUniCodeString = GetUniCodeString & Chr(AscB(MidB(s, a, 1)))
Next
End Function
Die Beispieldatei können Sie über den folgenden Link herunterladen:
