Makro als CSV Speichern mit Datumsangabe

[deschroe]

Hallo,

ich würde gerne bei folgendem Makro zusätzlich zum Dateinamen das Datum mit angeben.

Option Explicit
Sub CSV()
Dim wks As Worksheet, Datei As String, Pfad As String, Zaehler As Integer
Application.ScreenUpdating = False
For Each wks In ThisWorkbook.Sheets
   If LCase(wks.Name) <> "rohdaten" Then
       wks.Copy
       Pfad = "Pfadangabe"
       Datei = "Bestellung Shop" & Date
       
       If Not Dir(Pfad & Datei & ".CSV") = "" Then
          Zaehler = 1
          While Dir(Pfad & Datei & Zaehler) <> ""
             Zaehler = Zaehler + 1
          Wend
          Datei = Datei & Zaehler
       End If
       
       ActiveWorkbook.SaveAs Pfad & Datei & Date, xlCSV, Local:=True
       ActiveWorkbook.Close False
   End If
Next wks
Application.ScreenUpdating = True
MsgBox "Dateien erfolgreich gespeichert"
End Sub


Dies wäre mein Code aus einem anderen Projekt.
Meine beiden Ideen habe ich mal fett markiert.
In beiden Fällen wird der Dateiname richtig ergänz mit dem Datum.
Allerdings ändert sich das Dateiformat.
Daher meine Frage, was ich denn falsch mache.

Über Tipps wäre ich sehr dankbar.

VG

[cysu11]

Hi,

probiere das mal so, ungetestet:

Code:

Option Explicit
Sub CSV()
Dim wks As Worksheet, Datei As String, Pfad As String, Zaehler As Integer
Application.ScreenUpdating = False
For Each wks In ThisWorkbook.Sheets
   If LCase(wks.Name) <> "rohdaten" Then
       wks.Copy
       Pfad = "C:\users\rabe\downloads\"
       Datei = "Bestellung Shop " & Date & ".csv"
      
       If Not Dir(Pfad & Datei & ".CSV") = "" Then
          Zaehler = 1
          While Dir(Pfad & Datei & Zaehler) <> ""
             Zaehler = Zaehler + 1
          Wend
          Datei = Datei & Zaehler
       End If
      
       ActiveWorkbook.SaveAs Pfad & Datei, xlCSV, Local:=True
       ActiveWorkbook.Close False
   End If
Next wks
Application.ScreenUpdating = True
MsgBox "Dateien erfolgreich gespeichert"
End Sub

Pfad noch anpassen!
LG

Alexandra

[deschroe]

Vielen Dank. Es funktioniert soweit.

Nur ist irgendwie die Funktion weg, dass wenn ich die gleiche Datei 2x abspeichere, sich der Namen automatisch in Name1, Name2 usw. abändert.

Kannst du dir das ganze erklären?

Was hat sich verändert?

[cysu11]

Hi,

das musst du noch anpassen:

If Not Dir(Pfad & Datei & ".CSV") = "" Then

in 

das

If Not Dir(Pfad & Datei) = "" Then


LG
Alexandra

[deschroe]

Hallo Alexandra,

danke dir noch einmal für deine Rückmeldung.

Ich habe es angepasst und der Dateiname wird auch abgewandelt.
Allerdings ist es kein CSV Format mehr.

Option Explicit
Sub CSV()
Dim wks As Worksheet, Datei As String, Pfad As String, Zaehler As Integer
Application.ScreenUpdating = False
For Each wks In ThisWorkbook.Sheets
   If LCase(wks.Name) <> "rohdaten" Then
       wks.Copy
       Pfad = "Pfad"
       Datei = "Bestellung Shop " & Date & ".csv"
      
       If Not Dir(Pfad & Datei) = "" Then
          Zaehler = 1
          While Dir(Pfad & Datei & Zaehler) <> ""
             Zaehler = Zaehler + 1
          Wend
          Datei = Datei & Zaehler
       End If
      
       ActiveWorkbook.SaveAs Pfad & Datei, xlCSV, Local:=True
       ActiveWorkbook.Close False
   End If
Next wks
Application.ScreenUpdating = True
MsgBox "Dateien erfolgreich gespeichert"
End Sub

Stattdessen heißt die Datei dann Name.csv1 anstatt Name1.csv

[Käpt'n Blaubär]

Hallo,

dann lasse das ".CSV" weg.
If Not Dir(Pfad & Datei & ".CSV") = "" Then

[deschroe]

Hallo Peter,

eine Bedingung ist, dass es sich beim abspeichern um eine CSV Datei handelt.
Dies ist durch deine Anpassung nicht mehr gegeben.

Oder habe ich dich falsch verstanden?

[Käpt'n Blaubär]

Hallo,

eine Bedingung ist, dass es sich beim abspeichern um eine CSV Datei handelt. 
Dies ist durch deine Anpassung nicht mehr gegeben. 

Oder habe ich dich falsch verstanden?

... wenn ich Deinen Code richtig gelesen habe, dann war doch die CSV-Geschichte
dort schon verdrahtet. Darum taucht jetzt das CSV zweimal auf.

Aber nur, wenn ich das richtig verstanden habe.

[deschroe]

Hallo Peter,

danke für die schnelle Antwort.

Ich kann es mir nicht erklären.
Am Ende bei Durchlauf des Makros habe ich kein CSV Dateiformat mehr.

[cysu11]

Hi,

so: 

Code:

Sub CSV2()
Dim wks As Worksheet, Datei As String, Pfad As String, Zaehler As String, endung As String, da As String
Application.ScreenUpdating = False
For Each wks In ThisWorkbook.Sheets
  If LCase(wks.Name) <> "rohdaten" Then
      wks.Copy
      Pfad = "C:\users\rabe\downloads\"
      Datei = "Bestellung Shop "
      Zaehler = ""
      da = Date
      endung = ".csv"
      If Not Dir(Pfad & Datei & Zaehler & " - " & da & endung) = "" Then
         Zaehler = 1
         While Dir(Pfad & Datei & Zaehler & " - " & da & endung) <> ""
            Zaehler = Zaehler + 1
         Wend
         Datei = Datei
      End If
     
      ActiveWorkbook.SaveAs Pfad & Datei & Zaehler & " - " & da & endung, xlCSV, Local:=True
      ActiveWorkbook.Close False
  End If
Next wks
Application.ScreenUpdating = True
MsgBox "Dateien erfolgreich gespeichert"
End Sub

LG
Alexandra