Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Makro als CSV Speichern mit Datumsangabe
#1
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
Antworten Top
#2
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
[-] Folgende(r) 1 Nutzer sagt Danke an cysu11 für diesen Beitrag:
  • deschroe
Antworten Top
#3
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?
Antworten Top
#4
Hi,

das musst du noch anpassen:

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

in 

das

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


LG
Alexandra
[-] Folgende(r) 1 Nutzer sagt Danke an cysu11 für diesen Beitrag:
  • deschroe
Antworten Top
#5
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
Antworten Top
#6
Hallo,

dann lasse das ".CSV" weg.
If Not Dir(Pfad & Datei & ".CSV") = "" Then
________________________________________________________________________
wer aufgibt, ohne es versucht zu haben, gibt einfach nur auf!

Grüße aus Norderstedt, Peter
Antworten Top
#7
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?
Antworten Top
#8
Hallo,

Zitat: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.
________________________________________________________________________
wer aufgibt, ohne es versucht zu haben, gibt einfach nur auf!

Grüße aus Norderstedt, Peter
Antworten Top
#9
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.
Antworten Top
#10
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
[-] Folgende(r) 1 Nutzer sagt Danke an cysu11 für diesen Beitrag:
  • deschroe
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste