Office: Export als Unicode UTF-8 speichern

paddy3911 · 15. Juli 2017

Hallo,

ich versuche grade meinen Export als Unicode UTF-8 abzuspeichern, komme aber leider nicht weiter.

Wie muss ich den Code anpassen um die Datei wie gewünscht zu speichern ?

Code:

Sub Speichern() 'Export
Dim DstFileName As String, DstPfad As String
Dim Delimiter As String
Dim strZe As String
Dim lRow As Long, lCol As Integer
Dim Ze As Long, Sp As Integer
Dim ff As Integer

On Error GoTo ErrorHandler
DstPfad = "C:Test"
DstFileName = DstPfad & "CSV-Export.csv"
Delimiter = ","
With ActiveSheet
lRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lCol = .Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
ff = FreeFile
Open DstFileName For Output As #ff

For Ze = 2 To lRow
For Sp = 1 To lCol - 1
strZe = strZe & .Cells(Ze, Sp) & Delimiter
Next Sp
strZe = strZe & .Cells(Ze, Sp)
Print #ff, strZe
strZe = ""
Next Ze

End With

ErrorHandler:
If Err.Number 0 Then MsgBox "Fehler Nr. " & Err.Number & vbCrLf _
& Err.Description, vbCritical + vbOKOnly, "Fehler"
If ff > 0 Then Close #ff
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Danke bereits jetzt *Smilie

:)

EarlFred · 17. Juli 2017

Hallo,

ungetestet:
Code:

Option Explicit

Sub Speichern() 'Export
'NEU
Dim ACon As Object
'Ende NEU

Dim DstFileName As String, DstPfad As String
Dim Delimiter As String
Dim strZe As String
Dim lRow As Long, lCol As Integer
Dim Ze As Long, Sp As Integer
''''' Dim ff As Integer

On Error GoTo ErrorHandler
DstPfad = "C:Test"
DstFileName = DstPfad & "CSV-Export.csv"
Delimiter = ","
With ActiveSheet
lRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lCol = .Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
''''' ff = FreeFile
''''' Open DstFileName For Output As #ff

For Ze = 2 To lRow
For Sp = 1 To lCol - 1
strZe = strZe & .Cells(Ze, Sp) & Delimiter
Next Sp
strZe = strZe & .Cells(Ze, Sp)
''''' Print #ff, strZe
''''' strZe = ""

'NEU
strZe = strZe & vbLf
'Ende NEU
Next Ze

End With

'NEU
Set ACon = CreateObject("ADODB.Stream")

With ACon
.Type = 2
.Charset = "UTF-8"
.Open
.WriteText strZe, 0
.SaveToFile DstFileName, 2
.Close
End With

Set ACon = Nothing
'Ende NEU

ErrorHandler:
If Err.Number 0 Then MsgBox "Fehler Nr. " & Err.Number & vbCrLf _
& Err.Description, vbCritical + vbOKOnly, "Fehler"
If ff > 0 Then Close #ff
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Grüße
EarlFred

paddy3911 · 25. Juli 2017

Das hat funktioniert, vielen Dank *Smilie

Office: Export als Unicode UTF-8 speichern

Export als Unicode UTF-8 speichern

Export als Unicode UTF-8 speichern

Export als Unicode UTF-8 speichern - Similar Threads - Export Unicode UTF

Makros für csv-Export mit Anführungszeichen für ausgewählte Splaten

Export-Makro überschreibt .xlsx-Dateien nur taggleich

Export als Textdatei in UTF-8

Export CSV - Laufzeitfehler 3625

Outlook Export Assistent funktioniert nicht mehr

Fehler beim Export in eine PDF

Bildqualität beim Exportieren