Dublette beim speichern mit fortlaufender Nummer
29.08.2016 22:09:31
Aaron
ich benötige heute Abend wieder eure Hilfe.
Eine Xltm-Vorlage soll beim speichern als xlsx abgespeichert werden.
Hierzu habe ich bereits eine hervorragende Lösung im Forum erhalten.
https://www.herber.de/cgi-bin/callthread.pl?index=1510482&
Beim Verwenden der Vorlage hat sich nun aber herausgestellt, dass ab und an der selbe Dateiname auftritt und dadurch die alte Datei von der neuen Überschrieben wird.
Der Dateiname enthält das Datum, die Uhrzeit kann/darf ich allerdings nicht hinterlegen.
Ich hatte es über eine Inputbox versucht, es ist aber nicht gewährleistet, dass die Eintragungen immer von der selben Person gemacht werden, so dass hier eine Fehlerquelle vermieden werden könnte.
In einem weiteren Post hier im Forum habe ich diese Lösung gefunden:
https://www.herber.de/forum/archiv/812to816/812792_Datei_fortlaufend_speichern.html
... allerdings verzweifle ich im Moment, sie in meinem Code anzuwenden.
Meinen letzten Versuch füge ich anbei:
Private Sub
'# Prozedur Speichern der Tippgeberabrechnung als xlsx #
'Variablen festlegen
'Datum
Dim Datum
'Nachname Tippgeber
Dim Name
'Vorname Tippgeber
Dim Vorname
'Speicherpfad
Dim Speicherpfad
'Dateiname
Dim Dateiname
'Zähler
Dim Zähler
'Datei
Dim Datei
'Variablen bestimmen
'Datum
Datum = WS1.Range("B34").Text
'Nachname
Name = WS1.Range("B7").Value
'Vorname
Vorname = WS1.Range("B9").Value
'Speicherpfad
Speicherpfad = "C:\Users\XXXXXXXXXXXXXX\Desktop\test\"
'Dateiname
Dateiname = Datum & "_" & Name & " " & Vorname
'Zähler
Zähler = 0
'Datei
Datei = Dir(Speicherpfad & Dateiname)
Do Until Datei = ""
Zähler = Zähler + 1
Datei = Dir()
Loop
Sheets.Copy
'Kopie von Datei als xlsx speichern
Application.DisplayAlerts = False
If Zähler = 0 Then
ActiveWorkbook.SaveAs Filename:=Speicherpfad & Dateiname, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
Else
ActiveWorkbook.SaveAs Filename:=Speicherpfad & Dateiname & Zähler, FileFormat:= _
xlOpenXMLWorkbook
ActiveWorkbook.Close
End If
Application.DisplayAlerts = True
End sub
Leider finde ich den Fehler nicht - hat jemand von euch eine Lösung?
Ich freue mich auf eure Rückmeldung.