Hallo,

vielleicht noch kurz zur Ergänzung, was ich mit dem Code erreichen möchte:

Es soll aus einer vorhandenen Excel Datei eine csv Datei exportiert werden. Dabei müssen die Daten aus der Excel Tabelle durch ";" und "" getrennt werden, damit ich sie für einen weiteren Import verwenden kann. Trennung durch "," wäre unbrauchbar.

Die csv Datei soll automatisch mit dem Namen "import_" + aktuelles Datum und aktuelle Uhrzeit in einen vordefinierten Ordner abgespeichert werden.

Mit dem folgenden Code erreiche ich zwar eine automatische Abspeicherung unter dem passenden Namen am passenden Ort, jedoch erfolgt die Trennung durch "," und nicht durch ";" und "".

Wenn ich den Code, der für die Trennung verantwortlich ist, ohne automatisches Abspeichern durchlaufen lasse, funktioniert es einwandfrei. Es muss sich also irgendwo beim Zusammensetzen ein Fehler eingeschlichen haben, den ich bisher leider nicht gefunden habe oder es muss vielleicht etwas geändert oder ergänzt werden...

Für weitere Hilfe wäre ich sehr dankbar. Vielen Dank dafür im Voraus.

Sub CSVFile()
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FeldSep As String
Dim str As String
Const LW = "c:\"
Const Pfad = "c:\X\Y\Desktop\"
 
Dim FName As Variant
Dim Datumzeitstempel As String
Dim Jetzt As Date
Jetzt = Now()
Datumzeitstempel = Year(Date) & Format(Month(Date), "00") & Format(Day(Date), "00")
Datumzeitstempel = Datumzeitstempel & "" & Format(Hour(Jetzt), "00") & Format(Minute(Jetzt), "00") & Format(Second(Jetzt), "00")
ChDrive LW
ChDir Pfad
FName = Application.GetSaveAsFilename("date_" & Datumzeitstempel & ".csv")
 
ListSep = ","
If Selection.Cells.Count > 1 Then
Set SrcRg = Selection
Else
Set SrcRg = ActiveSheet.UsedRange
End If
Open FName For Output As #1
For Each CurrRow In SrcRg.Rows
CurrTextStr = ""
      FeldSep = IIf(CurrRow.Row < 2, "", """")
      For Each CurrCell In CurrRow.Cells
         CurrTextStr = CurrTextStr & FeldSep & CurrCell.Value & FeldSep & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #1, CurrTextStr
Next
Close #1
End Sub