Unicode Zeichen verarbeiten
18.04.2018 17:39:50
Jens
Ich will Tabellen die Unicode Zeichen enthalten in eine Unicode konforme Textdatei exportieren. Dazu habe ich mir ein VBA Makro geschrieben, dass mehrere Spalten untereinander weg in eine Datei schreiben soll. Da die fremdländischen Buchstaben zunächst als Fragezeichen auftauchten habe ich etwas herum experimentiert.
Zunächst habe ich diesen Ansatz hier probiert:
https://stackoverflow.com/questions/30933062/how-to-save-txt-as-unicode-or-utf-8-in-vba
Der hat aber nicht funktioniert bei mir.
Als nächstes habe ich diesen Ansatz probiert:
https://stackoverflow.com/questions/14261632/how-can-i-create-text-files-with-special-characters-in-their-filenames
Leider ist mein VBA nicht gut genug, dass das Ergebnis korrekt ist.
Hier sind die Daten mit denen ich arbeite. Die Tabelle enthält sehr viele verschiedene Sprachen und damit auch Zeichen aus anderen Sprachen. So wie sie hier auf der Webseite dargestellt sind erscheinen sie auch in meinem Excel file. Jedoch nicht mehr nach dem Export in eine .txt Datei.
https://cloud.google.com/speech-to-text/docs/languages
Hier ist der VBA Code welcher kein richtiges Ergebnis ausschreibt:
Sub Create_New_Text_File_from_all_Columns()
'Variablen definieren
Dim strCRLF As String, strSpecialchars As String
Dim oFSO As Object, oFile As Object
Dim Cr As Long, Cc As Integer, CrE As Long, CcE As Integer
Dim i As Long, n As Long, y As Long
Dim CHeader As String, ExPfad As String, Exfile As String
'Exportpfad mit Backslash am Schluss definieren !!
ExPfad = "C:\Users\Me\"
Cr = 65536
'Schliessen einer evetnuell noch geöffneten Datei
Close #1
'Letzte Spalte bestimmen
If Cells(4, 500) = "" Then
CrE = Cells(4, 500).End(xlToLeft).Column
End If
'1. Öffnen der Datei
'Den Namen und Pfad bitte anpassen
Exfile = ExPfad & Cells(1, 1)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.CreateTextFile(Exfile, , True)
'With FSO For Output As #1
'Beginn der Export Schleife
For i = 7 To CrE - 1 Step 2
If Cells(Cr, i) = "" Then
Cr = Cells(Cr, i).End(xlUp).Row
End If
'Beginn des Datenexports in die Textdatei
For n = 4 To Cr
'Write oder Print verwenden
strCRLF = StrConv(vbCrLf, vbUnicode)
'strSpecialchars = StrConv(Cells(n, i), vbUnicode)
oFile.Write Cells(n, i) & strCRLF
Next n
Cr = 65536
Next i
'Schliessen der Datei weil Dateiende erreicht wurde
oFile.Close
Set oFile = Nothing
Set oFSO = Nothing
MsgBox "Textdatei wurde in " & ExPfad & " erstellt"
End Sub
Anzeige