Hallo zusammen . Ich muss mehrere csv datei in csv/xlsx format mit einem Charset UTF-8 kodierung transformieren .
Jetzt mache ich mir Gedanken, wie man für mehere datei in beliebiger Ordner es macht . z.B. mittels der Do While :
Sub CommandButton2_Click()
Dim CSVfolder As String, _
XlsFolder As String, _
fname As String, _
wBook As Workbook
CSVfolder = "D:\abc\csv1\"
XlsFolder = "D:\abc\csv1\"
fname = Dir(CSVfolder & "*.csv")
Do While fname <> ""
Set wBook = Workbooks.Open(CSVfolder & fname, Format:=6, Delimiter:=",")
wBook.SaveAs XlsFolder & Replace(fname, ".csv", ""), xlOpenXMLWorkbook
wBook.Close True
fname = Dir
Loop
End Sub
. Also bis jetzt funktioniert mit einem File , muss aber für alle bzw für merhere. Thx all
Public Sub convert_UnicodeToUTF8()
Dim parF1, parF2 As String
parF1 = "D:\abc\csv1\MusterFile.csv"
parF2 = "D:\abc\csv1\MusterFile.csv"
Const adSaveCreateOverWrite = 2
Const adTypeText = 2
Dim StreamSrc, streamDst ' Source / Destination
Set StreamSrc = CreateObject("ADODB.Stream")
Set streamDst = CreateObject("ADODB.Stream")
streamDst.Type = adTypeText
streamDst.Charset = "UTF-8"
streamDst.Open
With StreamSrc
.Type = adTypeText
.Charset = "UTF-8"
.Open
.LoadFromFile parF1
.copyTo streamDst
.Close
End With
streamDst.SaveToFile parF2, adSaveCreateOverWrite
streamDst.Close
Set StreamSrc = Nothing
Set streamDst = Nothing
Call csvToxlsx
End Sub
Thx