csv-Speicherung
17.01.2022 09:06:49
EasyD
wer kann das Brett vor meinem Kopf entfernen - folgende Prozedur soll das Blatt "Export" in einem Verzeichnis speichern, welches in Zelle G54 des Blattes "Bearbeitungshinweise" steht wie folgt: Z:\Kontakte\E
Die Speicherung an sich funktioniert, allerdings habe ich nach langem Suchen die zu erstellende csv-Datei in meinem Benutzer-Ordner "Dokumente" gefunden.
Was ist die Ursache / wo liegt mein Fehler?
Sub SaveAsCSV()
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
Dim Text As Range
Dim rngZelle As Range
Set Text = Sheets("Export").Range("G2:G" & Cells(Rows.Count, 7).End(xlUp).Row + 1)
'Sicherheitshalber im Text (Spalte G) alle Semikolons durch Kommata ersetzen
For Each rngZelle In Text
rngZelle.Value = Replace(rngZelle.Value, ";", ",")
Next rngZelle
On Error GoTo ErrorHandler
DstPfad = Sheets("Bearbeitungshinweise").Range("G54")
DstFileName = "Datenaustausch" & Format(Date, "dd.mm.yyyy") & ".csv"
Delimiter = ";"
With Sheets("Export")
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
'Zeile für Zeile lesen und schreiben ...
For Ze = 1 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, "Das ging schief ..."
If ff > 0 Then Close #ff
MsgBox "Fertig"
'zuletzt alle zeilen löschen außer Überschrift
Sheets("Export").Rows("2:65536").ClearContents
End Sub