EXCEL: Makro, txt als UTF 8 speichern!?

[ixu]

Hallo, ich habe folgendes Makro:

Option Explicit
Sub Profile_als_TXT_exportieren()
'Variablen definieren
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:\Temp\"
Cr = 65536
'Schliessen einer evetnuell noch geöffneten Datei
Close #1
'Letzte Spalte bestimmen
If Cells(1, 347) = "" Then
CrE = Cells(1, 347).End(xlToLeft).Column
End If
'Beginn der Export Schleife
For i = 1 To CrE
If Cells(Cr, i) = "" Then
Cr = Cells(Cr, i).End(xlUp).Row
End If
'1. Öffnen der Datei
'Den Namen und Pfad bitte anpassen
Exfile = ExPfad & Cells(1, i) & ".txt"
Open Exfile For Output As #1
'Beginn des Datenexports in die Textdatei
For n = 2 To Cr
'Write oder Print verwenden
Print #1, Cells(n, i)
Next n
'Schliessen der Datei weil Dateiende erreicht wurde
Close #1
Cr = 65536
Next i
MsgBox i & " Textdateien wurden in " & ExPfad & " erstellt"
End Sub



Meine Excelliste hat 50spalten und 347 Zeilen.
In jeder Spalte werden andere Werte für die Profile generiert (Also ein Profil pro Spalte).

Das Makro baut mir nun aus jeder Spalte eine zusammenhängende .txt Datei.
Leider speichert er sie mit ANSI-Kodierung.

Wäre es möglich die .txt Datein gleich mit UTF8 bzw. UTF8 ohne BOM speichern zu lassen?

 

[Wishbringer]

object.CreateTextFile(filename[, overwrite[, unicode]])
object.OpenTextFile(filename[, iomode[, create[, format]]])

oder hilft das?

Sub WriteUTF8WithoutBOM()
Dim UTFStream As Object
Set UTFStream = CreateObject("adodb.stream")
UTFStream.Type = adTypeText
UTFStream.Mode = adModeReadWrite
UTFStream.Charset = "UTF-8"
UTFStream.LineSeparator = adLF
UTFStream.Open
UTFStream.WriteText "This is an unicode/UTF-8 test.", adWriteLine
UTFStream.WriteText "First set of special characters: öäåñüûú€", adWriteLine
UTFStream.WriteText "Second set of special characters: qwertzuiopõúasdfghjkléáûyxcvbnm\|Ä€Í÷×äðÐ[]í³£;?¤>#&@{}<;>*~¡^¢°²`ÿ´½¨¸0", adWriteLine

UTFStream.Position = 3 'skip BOM

Dim BinaryStream As Object
Set BinaryStream = CreateObject("adodb.stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Mode = adModeReadWrite
BinaryStream.Open

'Strips BOM (first 3 bytes)
UTFStream.CopyTo BinaryStream

'UTFStream.SaveToFile "d:\adodb-stream1.txt", adSaveCreateOverWrite
UTFStream.Flush
UTFStream.Close

BinaryStream.SaveToFile "d:\adodb-stream2.txt", adSaveCreateOverWrite
BinaryStream.Flush
BinaryStream.Close
End Sub

 

[ixu]

Vielen Dank für deine Antwort!



leider nein, bekomme ich nicht zum laufen.
kann man meins nicht "erweitern" um einen einfachen befehl? damit ich die funktion mit der Spaltenweise exportierung nicht verliere.