123660
Goto Top

Excel tabelle mit sonderzeichen via vba speichern

Hallo Zusammen,
Ich hoffe ihr könnt mir weiter helfen, mein Problem ist folgendes:
In meine Excel Tabelle sind viele Sonderzeichen und wenn ich das speichere mit mein Code werden alle sondere Zeichen nicht erkannt da erscheint nur ein frage Zeichen.
hat jemand ein Idee?
danke im Voraus.
Code:
Sub Speichern_Csv()
' Speichert den Inhalt eines Arbeitsblatts als CSV-Datei
' mit wählbarem Trennzeichen und Maskierung von Einträgen

Dim Bereich As Object, Zeile As Object, Zelle As Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String

strMappenpfad = ActiveWorkbook.Name
strMappenpfad = Replace(strMappenpfad, ".xls", "")

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then Path = .SelectedItems(1)
End With
z = InputBox("Wie soll die CSV-Datei heißen?", "CSV-Export", strMappenpfad)
'Z = ActiveWorksheet.FullName , "CSV-Export", strMappenpfad

strDateiname = Path & "\" & z & ".txt"
If strDateiname = "" Then Exit Sub

strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ";")
If strTrennzeichen = "" Then Exit Sub

Set Bereich = ActiveSheet.UsedRange

Open strDateiname For Output As #1

For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
Next

Close #1
Set Bereich = Nothing
MsgBox "Datei wurde exportiert nach" & vbCrLf & strDateiname

End Sub

Content-Key: 286126

Url: https://administrator.de/contentid/286126

Ausgedruckt am: 28.03.2024 um 08:03 Uhr

Mitglied: 114757
114757 20.10.2015 aktualisiert um 10:20:47 Uhr
Goto Top
Moin,
der Grund du öffnest das File nicht als Unicode
http://www.access-im-unternehmen.de/590.0.html
Set objFSO = CreateObject("Scripting.FileSystemObject")  
Set file = objFSO.CreateTextFile("c:\Unicode.txt", True, True)  
file.WriteLine "Häää Ösi is übel"  
file.Close
Gruß jodel32
Mitglied: 123660
123660 26.10.2015 um 08:52:49 Uhr
Goto Top
Hallo jodel32,
Sorry für die späte Rückmeldung, ich war ein bissen krank.
Das ist genau mein Problem, ich weiß aber nicht wie ich das an mein Code anpasse
Gruß Achraf
Mitglied: 114757
Lösung 114757 26.10.2015 aktualisiert um 09:25:50 Uhr
Goto Top
Oh Mann wohl noch kein Kaffe gehabt ?! Da präsentiert man es schon auf dem Silbertablett *Koppschüttel*
Sub Speichern_Csv()
' Speichert den Inhalt eines Arbeitsblatts als CSV-Datei
' mit wählbarem Trennzeichen und Maskierung von Einträgen

Dim Bereich As Object, Zeile As Object, Zelle As Object, objFSO as Object, file als Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String

Set objFSO = CreateObject("Scripting.FileSystemObject")

strMappenpfad = ActiveWorkbook.Name
strMappenpfad = Replace(strMappenpfad, ".xls", "")

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then Path = .SelectedItems(1)
End With
z = InputBox("Wie soll die CSV-Datei heißen?", "CSV-Export", strMappenpfad)

strDateiname = Path & "\" & z & ".txt"
If strDateiname = "" Then Exit Sub

strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ";")
If strTrennzeichen = "" Then Exit Sub

Set file = objFSO.CreateTextFile(strDateiname, True, True)

Set Bereich = ActiveSheet.UsedRange

For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)
file.WriteLine strTemp
strTemp = ""
Next

file.Close
Set Bereich = Nothing
MsgBox "Datei wurde exportiert nach" & vbCrLf & strDateiname

End Sub
Mitglied: 123660
123660 26.10.2015 um 09:21:57 Uhr
Goto Top
Hallo jodel32,
Vielen vielen Dank, es funktioniert so wie gewollt.
Du verdienst mehr als ein Kaffee.
schönen Tag noch
Gruß achraf