Speichern unter, fortlaufende Nr. mit Prüfung

Hallo,
habe mich nach langer Zeit mal wieder an eine kleine Sache herangewagt und verstehe eine Sache nicht wirklich.
Wäre klasse wenn Ihr mir etwas helfen könntet.
Ich habe für einen Basar ein automatisiertes Kassensystem gebastelt und haut auch wunderbar hin.
Hier der relevante Teil zur Funktion des UserForms:


Private Sub UserForm_Initialize()
'Einträge für Schaltflächen
KassenForm.KundenIDBox.Value = ""
KassenForm.AnbieternrBox.Value = ""
KassenForm.ArtikelnrBox.Value = ""
KassenForm.PreisBox.Value = ""
End Sub
Private Sub CommandNextItem_Click()
'Artikel in Tabelle übernehmen und nächsten Artikel, Kunden-ID bleibt gleich!
Dim last As Integer
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Cells(last, 1).Value = KassenForm.KundenIDBox
ActiveCell.Value = KassenForm.KundenIDBox * 1
'Das * 1 macht aus einem Text eine Zahl in Excel! Beispiel: Range("A1").Value = UserForm1. _
TextBox1 * 1
ActiveSheet.Cells(last, 2).Value = KassenForm.AnbieternrBox
ActiveSheet.Cells(last, 3).Value = KassenForm.ArtikelnrBox
ActiveSheet.Cells(last, 4).Value = CCur(KassenForm.PreisBox)     'CCur mit Euro-Angabe    _
CDate wäre für Datumsformat
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
KassenForm.AnbieternrBox.Value = ""
KassenForm.ArtikelnrBox.Value = ""
KassenForm.PreisBox.Value = ""
KassenForm.AnzahlArtikelBox.Value = Range("K2").Value * 1
KassenForm.SummeBox.Value = Format(CDbl(Range("E2")), "#,###.00 ")
Sum = Format(CDbl(Range("E2")), "#,###.00 ")
KassenForm.AnbieternrBox.SetFocus
Call speichern_unter_fortlaufend
End Sub

Da mein Laptop keine Batterie mehr hat und ich vermeiden möchte, im Falle eines Stromausfalls alle Daten zu verlieren, habe ich versucht ein Speichern unter Makro zu basteln, das hat leider nicht hingehauen.
ich habe mir daher eines in den Foren gesucht und angepasst.
Leider funktioniert es nicht so wie gedacht.

Bei jedem Drücken des Buttons: "CommandNextItem" (Datenübergabe in die Tabelle), soll die Excel-Datei unter einer fortlaufenden Nr. gespeichert werden, ohne dass das einer sieht.

Zur Zeit passiert folgendes: (Ich habe DisplayAlerts zum Testen erstmal rausgenommen)

1. Drücken des Buttons,
Es wird im entsprechenden Pfad eine Datei gespeichert die eine 1 angefügt hat.
Das passt also.

2. Drücken des Buttons,
System fragt mich, da "DisplayAlerts True", ob die bereits vorhandene Datei mit der angehängten 1 überschrieben werden soll!?
Das ist Mist...

Es soll wie folgt funktionieren:

Beim 2., 3., 4. usw. Drücken des Buttons,
System erkennt falls die Datei bereits vorhanden und erhöht den Zähler automatisch solange weiter bis der Pfad leer ist

In etwa so:

Do Until pfad = ""
zähler = zähler + 1
pfad = Dir()

Aber das bekomme ich leider nicht hin :-(
Hier die gefundene Version die ich versucht habe umzubauen.


Sub speichern_unter_fortlaufend()
Dim pfad As String
Dim Filename As String
'Filename:=Filename
pfad = ThisWorkbook.Path
Dim i As Long
With Application.FileSearch
.LookIn = pfad
'Filename = Execute
If .Execute > 0 Then i = .FoundFiles.Count
i = i + 1
'Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=pfad & "\" & "Abrechnung2018_V1.7" & Format(i, "0") & ".xlsm",  _
CreateBackup:=False
'Application.DisplayAlerts = True
End With
End Sub

Ich bedanke mich schonmal und freue mich auf jede Hilfe.
LG Fly

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub speichern_unter_fortlaufend() Dim lstrFile As String, lstrSplit() As String lstrFile = ThisWorkbook.FullName lstrFile = Left(lstrFile, Len(lstrFile) - 5) lstrFile = Replace(lstrFile, "Abrechnung2018_V1.7", "") If Right(lstrFile, 1) = "\" Then lstrFile = lstrFile & "Abrechnung2018_V1.71.xlsm" Else lstrSplit = Split(lstrFile, "\") lstrFile = Left(lstrFile, Len(lstrFile) - Len(lstrSplit(UBound(lstrSplit)))) lstrFile = lstrFile & "Abrechnung2018_V1.7" & CInt(lstrSplit(UBound(lstrSplit))) _ + 1 & ".xlsm" End If ActiveWorkbook.SaveAs Filename:=lstrFile End Sub

Private mlngLfdNr As Long 'als modulweite Variable deklarieren Sub speichern_unter_fortlaufend() Dim pfad As String Dim sFilename As String Dim i As Long Dim sFormatNr As String sFormatNr = """_""0000" 'Format der laufenden Nr im Dateinamen pfad = ThisWorkbook.Path & "\Copy" 'Verzeichnis Sicherheitskopien If Dir(pfad, vbDirectory) = "" Then VBA.MkDir pfad mlngLfdNr = 0 End If 'Dateiname ohne laufende Nr. sFilename = ThisWorkbook.Name sFilename = Left(sFilename, InStrRev(sFilename, ".") - 1) If mlngLfdNr = 0 Then 'nächste fortlaufende Nr. für Sicherheitskopie ermitteln i = 0 Do i = i + 1 If Dir(pfad & "\" & sFilename & Format(i, sFormatNr) & ".xlsm") = "" Then mlngLfdNr = i Exit Do End If Loop Else mlngLfdNr = mlngLfdNr + 1 End If sFilename = pfad & "\" & sFilename & Format(mlngLfdNr, sFormatNr) & ".xlsm" ThisWorkbook.SaveCopyAs Filename:=sFilename End Sub

Hallo nochmal,
ich meine die Problematik erkannt zu haben.
SaveCopyAs speichert die Datei als .xls.
Da im Makro die .xls Kopie mit der .xlsm Endung versehen wird, kommt der Konverter von Excel 2003 durcheinander und kann die Kopie nicht ändern.
Ich habe das getestet, indem ich eine der Kopien in eine .xls Datei umbenenne und schon ließ sie sich öffnen.
Jetzt meine Fragen zum Thema:

Ich war immer der Meinung das Exceldateien mit enthaltenem Makro, .xlsm Dateien sein müssen.
Warum funktioniert das Makro denn noch obwohl es jetzt eine xls. Datei ist?
Liegt das daran das ich Excel 2003 nutze?
Kann Excel 2010 und folgende die Datei dann öffnen oder muss es bei denen dann wieder eine xlsm sein?/li>

Kann man die Datei nicht gleich direkt als xlsm speichern?
Ich habe im folgendem Forum einen Beitrag zu diesem Thema gefunden.
https://www.mrexcel.com/forum/excel-questions/504233-vba-save-copy-cannot-open-file.html

Vielleicht könnte man das Dateiformat 52 = xlOpenXMLWorkbookMacroEnabled (Excel 2007 mit oder ohne Makros - XLSM) ja in das Makro einbringen, so dass der Dateikonverter das richtige Format vorliegen hat?
Dann dürften sich die Dateien auch wieder öffnen lassen.

Vielen Dank und Gruß
Fly
You have to save a Workbook in the Same file format as you run the Save Procedure. Excel will not recognize the new WB as the same Type WB from where it was saved from..
So the Save As Module sits in Personal.xlsm, so when I run the Macro it saves the workbook as a .xlsx but since Macro originally came from Personal.xlsm it confuses Excel and it thinks it should be a .xlsm file.
So if I use the same macro in a module within the WB then it works fine. IF you run a macro from another location. It thinks its a .xlsm but saved as a .xlsx. So it says file format invalid.
Die Antwort hierzu:
Instead of doing a .SaveCopyAs to the new filename and continue with the original name active, try this: do a .SaveAs to the new filename specifying the file format, then do a .SaveAs back to your original filename. That will have the same final result.
Here's how to specify the file format when doing a .SaveAs:

ThisWorkbook.SaveAs ("C:\Users\MTS\Documents\Excel Backup Files\" & wbName), FileFormat:=xlOpenXMLWorkbook
or:

ThisWorkbook.SaveAs ("C:\Users\MTS\Documents\Excel Backup Files\" & wbName), FileFormat:=51
That's assuming you're saving an XLSX file. For other types, use:-
51 = xlOpenXMLWorkbook (Excel 2007 without macros - XLSX)
52 = xlOpenXMLWorkbookMacroEnabled (Excel 2007 with or without macros - XLSM)
50 = xlExcel12 (Excel 2007 Binary Workbook with or without macros - XLSB)
56 = xlExcel8 (Excel 97-2003 - XLS)

Private mlngLfdNr As Long 'als modulweite Variable deklarieren Sub speichern_unter_fortlaufend() Dim pfad As String Dim sFilename As String, sExt As String Dim i As Long Dim sFormatNr As String sFormatNr = """_""0000" 'Format der laufenden Nr im Dateinamen pfad = ThisWorkbook.Path & "\Copy" 'Verzeichnis Sicherheitskopien If Dir(pfad, vbDirectory) = "" Then VBA.MkDir pfad mlngLfdNr = 0 End If 'Dateiname ohne laufende Nr. sFilename = ThisWorkbook.Name Select Case Val(Left(Application.Version, 2)) Case Is > 11 '2007 und neuer sExt = Mid(sFilename, InStrRev(sFilename, ".")) Case Else sExt = ".xls" End Select sFilename = Left(sFilename, InStrRev(sFilename, ".") - 1) If mlngLfdNr = 0 Then 'nächste fortlaufende Nr. für Sicherheitskopie ermitteln i = 0 Do i = i + 1 If Dir(pfad & "\" & sFilename & Format(i, sFormatNr) & sExt) = "" Then mlngLfdNr = i Exit Do End If Loop Else mlngLfdNr = mlngLfdNr + 1 End If sFilename = pfad & "\" & sFilename & Format(mlngLfdNr, sFormatNr) & sExt ThisWorkbook.SaveCopyAs Filename:=sFilename End Sub

Beliebteste Forumthreads (12 Monate)

Speichern unter, fortlaufende Nr. mit Prüfung

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Speichern unter, fortlaufende Nr. mit Prüfung

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread