Excel Makro: Datei speichern unter anderem Namen, falls Name in Ordner schon vorhanden ist

Question

Ich habe in Excel ein Makro geschrieben, dass die Datei unter einem bestimmten Namen speichert, der sich aus verschiedenen Teilen zusammensetzt, die in der Tabelle gefunden werden (z.B. Angebot vom Datum für Kunde).
Nun kommt es vor, dass für einen Kunden mehrere Angebote am Tag erstellt werden müssen. Trotzdem soll aber automatisch gespeichert werden, ohne den Namen händisch ändern zu müssen. Schön wäre es, wenn man prüfen könnte, ob bereits eine Datei mit dem Namen existiert, und falls dem so ist, die aktuelle Datei unter einem anderen Namen (z.B. Angebot 2 vom Datum für Kunde). Falls "Angebot 2 vom Datum für Kunde" schon existiert, dann eben unter "Angebot 3 vom Datum für Kunde".

Ich bräuchte also irgendeine Art "Counter i", der mir die Nummer um eins erhöht, falls der Name existiert, beim ersten Angebot des Tages aber nicht die 1 anzeigt...

Geht sowas in irgendeiner Form?

Vielen Dank im Voraus

Answer 1

hi all ^^

ein beispiel :-)

gruss nighty

den pfad bei der ersten function angepassen

Sub Beispiel()
'mustertabelle test
'test wird test1,test2 usw. erzeugt
If NeueZahl() = "" Then
'speichern ohne nummer bei rueckgabewert von 0
'hier deine speicherfunction einsetzen
Else
'speichern mit nummer bei rueckgabewert von groesser 0
'hier deine speicherfunction einsetzen & NeueZahl()
End If
End Sub

Function NeueZahl() As String
Dim DateiPath As String
Dim DateiEndung As String
Dim DateiName As String
Dim DateiNamen() As String
Dim zaehler1 As Long
Dim Dinfo As Long
Dim AltZahl As Long
DateiPath = "C:\temp1\"
DateiEndung = "*.xls"
zaehler1 = 1
ReDim Preserve DateiNamen(zaehler1)
DateiName = Dir(DateiPath & DateiEndung)
Do While DateiName <> ""
zaehler1 = zaehler1 + 1
ReDim Preserve DateiNamen(zaehler1)
DateiNamen(zaehler1) = DateiName
DateiName = Dir
Loop
For Dinfo = 2 To UBound(DateiNamen())
If Mid(DateiNamen(Dinfo), 1, Len(ActiveWorkbook.Name) - 4) = Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - 4) Then
If Val(SumZahlen(Mid(DateiNamen(Dinfo), 1, Len(DateiNamen(Dinfo)) - 4), 1)) > AltZahl Then
AltZahl = Val(SumZahlen(Mid(DateiNamen(Dinfo), 1, Len(DateiNamen(Dinfo)) - 4), 1))
NeueZahl = AltZahl + 1
End If
End If
Next Dinfo
End Function

Function SumZahlen(Zellen As Variant, zaehler1 As Integer) As String
Dim Zelle As Range
Dim zeich1 As Integer
Dim schalter As Boolean
Dim zaehler3 As Integer
ReDim Zaehler2(Len([Zellen])) As String
zaehler3 = 1
Application.Volatile
If zaehler1 > Len([Zellen]) Then zaehler1 = Len([Zellen])
For zeich1 = 1 To Len([Zellen])
If Mid([Zellen], zeich1, 1) Like "[0-9,.]" = True Then
Zaehler2(zaehler3) = Zaehler2(zaehler3) & Mid([Zellen], zeich1, 1)
schalter = True
End If
If schalter = True And Mid([Zellen], zeich1, 1) Like "[0-9,.]" = False Then
zaehler3 = zaehler3 + 1
schalter = False
End If
Next zeich1
SumZahlen = Zaehler2(zaehler1)
End Function

Answer 2

hi all ^^

das ginge bestimmt auch kuerzer :-)))

gruss nighty

Answer 3

hi all ^^

korrigiert und vielleicht mit besserem beispiel

gruss nighty

sollte das datum vorangestellt sein,dann die kommentare der naechsten function beachten

Sub Beispiel()
If NeueZahl() = 0 Then
ActiveWorkbook.SaveCopyAs Filename:="C:\temp1\" & ActiveWorkbook.Name
Else
ActiveWorkbook.SaveCopyAs Filename:="C:\temp1\" & Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - 4) & NeueZahl() & ".xls"
End If
End Sub

Function NeueZahl() As Integer
Dim DateiPath As String
Dim DateiEndung As String
Dim DateiName As String
Dim DateiNamen() As String
Dim zaehler1 As Long
Dim Dinfo As Long
Dim AltZahl As Integer
DateiPath = "C:\temp1\"
DateiEndung = "*.xls"
zaehler1 = 1
ReDim Preserve DateiNamen(zaehler1)
DateiName = Dir(DateiPath & DateiEndung)
Do While DateiName <> ""
zaehler1 = zaehler1 + 1
ReDim Preserve DateiNamen(zaehler1)
DateiNamen(zaehler1) = DateiName
DateiName = Dir
Loop
For Dinfo = 2 To UBound(DateiNamen())
If Mid(DateiNamen(Dinfo), 1, Len(ActiveWorkbook.Name) - 4) = Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - 4) Then
'waere das datum vor der zahlengenerierung,dann die zweite 1 in der naechsten zeile durch eine 2 ersetzen
If Val(SumZahlen(Mid(DateiNamen(Dinfo), 1, Len(DateiNamen(Dinfo)) - 4), 1)) > AltZahl Then
'waere das datum vor der zahlengenerierung,dann die zweite 1 in der naechsten zeile durch eine 2 ersetzen
AltZahl = Val(SumZahlen(Mid(DateiNamen(Dinfo), 1, Len(DateiNamen(Dinfo)) - 4), 1))
End If
NeueZahl = AltZahl + 1
End If
Next Dinfo
End Function

Function SumZahlen(Zellen As Variant, zaehler1 As Integer) As String
Dim Zelle As Range
Dim zeich1 As Integer
Dim schalter As Boolean
Dim zaehler3 As Integer
ReDim Zaehler2(Len([Zellen])) As String
zaehler3 = 1
Application.Volatile
If zaehler1 > Len([Zellen]) Then zaehler1 = Len([Zellen])
For zeich1 = 1 To Len([Zellen])
If Mid([Zellen], zeich1, 1) Like "[0-9,.]" = True Then
Zaehler2(zaehler3) = Zaehler2(zaehler3) & Mid([Zellen], zeich1, 1)
schalter = True
End If
If schalter = True And Mid([Zellen], zeich1, 1) Like "[0-9,.]" = False Then
zaehler3 = zaehler3 + 1
schalter = False
End If
Next zeich1
SumZahlen = Zaehler2(zaehler1)
End Function