ExcelCSV-Export
07.03.2021 10:03:19
wethlo
Ich habe folgende Excel-Datei erstellt:
https://www.herber.de/bbs/user/144534.xlsm
Diese enthält ein VBA-Makro, welches ich im Internet gefunden habe (siehe Zitat...):
Das Makro bewirkt, dass das Tabellenblatt in eine CSV exportiert wird, welche ich als Import-Datei für eine andere Software benötige. Soweit so gut.
Meine Wünsche wären nun folgende:
- Die beiden Abfragen nach Speicherort und Trennzeichen sollten nicht aufpoppen. Die Einstellungen der beiden Fenster passen so. Nur das dritte Fenster, dass die Datei erfolgreich exportiert wurde sollte erscheinen.
- Da in dem Tabellenblatt zwar leere Zeilen sind, die aber doch nicht leer sind (300 Stück) werden mir die nicht befüllten Zeilen mit Semikolons in die CSV geschrieben (;;;;;;;;;;;;;;;). Diese sind für die Software, in die die CSV-Datei importiert wird, sehr unvorteilhaft. Heißt also, dass das Makro diese noch löschen sollte.
Meine Excel-Kenntnisse sind einigermaßen gut, meine VBA-Kenntnisse dagegen komplett bescheiden.
Über Hilfe würde ich mich sehr freuen :-)
Hier noch das VBA-Makro:
Sub TEST()
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.FullName
strMappenpfad = Replace(strMappenpfad, ".xlsm", ".csv")
strDateiname = InputBox("Wie soll die CSV-Datei heißen (inkl. Pfad)?", "CSV-Export", _
strMappenpfad)
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 Zelle.Value = 0 Then
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
Else
If InStr(1, Zelle.Value, strTrennzeichen) > 0 Then
'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Value) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Value) & strTrennzeichen
End If
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