in Dateinamen fortlaufende Zahl einfügen

Hallo hab das Problem noch offen, das ich allein nicht schaffe:
derzeit speichere ich mit untenstehendem Makro meine Dateien in einem Order,
der soll immer "D:\Eigene Dateien\Ordi\Buchhaltung\fertigzustellende Rechnungen\" sein.
Mit einem persönlichen Namen aus einer Zelle (d82)ab, aus der Tabelle " KK "(die Datei heisst OOEGKK FA 07-1).
Dann vergebe ich von Hand eine fortlaufende Nummer wie 2002-10-123, Jahr+Monat+3-stellig forlaufende Zahl.
nur die letzten 3 Zahlen sollen variabel sein.
bsp: im Ordner stehen schon Dateien die heissen:
Mayr Franz 2006-04-555.xls
Mauhart Anna 2006-04-556.xls
dann hätte ich gern bei dem Namen (bsp Müller Waltraud, der aus Zelle d82 kopiert wird) dahinter: 2006-04-557 dazugefügt.
Die Nummerierung soll zusätzlich zu den Namen in den Dateinamen kommen.
das Jahr und das Monat richten sich nach den in diesem Ordner schon vorhandenen Zahlen, kann aktuell sein oder nicht,
die gilt es nur zu kopieren, die hinteren 3 Stellen sollen +1 zur letzt größten sein
Die Laufnummer erhöht sich nur im Monat.
Nullen werden erwartet wie 001,oder 012
es gibt nicht mehr als 999
der Code ist in einem Modul (7):


Sub speichern_unter()
Dim str As String
str = Range("d82").Value
ActiveWorkbook.SaveAs filename:= _
"D:\Eigene Dateien\Ordi\Buchhaltung\fertigzustellende Rechnungen\" & str & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Kann mir das jemand von euch Profis so ergänzen, daß automatisch die letzte 11-stellige Zahl in den Dateinamen im Ordner gesucht wird un dann mit +1 hinzugefügt wird? Danke
Ciao, grazie

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub speichern_unter() Dim intN As Integer, strName As String Const strOrdn = "D:\Eigene Dateien\Ordi\Buchhaltung\fertigzustellende Rechnungen\" intN = HoleNr(strOrdn) If intN >= 0 Then _ ActiveWorkbook.SaveAs Filename:=strOrdn & Cells(82, 4) & intN & ".xls" End Sub Function HoleNr(strOrdner As String) As Integer Dim objFSO As Object, objFol As Object, objFile As Object Dim intNr As Integer, strT1 As String, strT2 As String Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFol = objFSO.GetFolder(strOrdner) For Each objFile In objFol.Files 'abcd xyz 2006-04-556.xls If objFile.Name Like "* ####-##-###.xls" Then strT2 = Left(Right(objFile.Name, 15), 7) Select Case strT1 Case strT2 Case "": strT1 = strT2 Case Is <> strT2 HoleNr = -1 MsgBox "In '" & strOrdner & "' stehen Dateien zu verschiedenen Monaten.", _ vbCritical, "Abbruch" Exit Function End Select intNr = Left(Right(objFile.Name, 7), 3) If HoleNr < intNr Then HoleNr = intNr End If Next objFile HoleNr = HoleNr + 1 End Function

Option Explicit Sub speichern_unter() Dim intN As Integer, strName As String, strTxt As String Const strOrdn = "D:\Eigene Dateien\Ordi\Buchhaltung\fertigzustellende Rechnungen\" HoleNr strOrdn, strTxt, intN If intN >= 0 Then _ ActiveWorkbook.SaveAs Filename:= _ strOrdn & Cells(82, 4) & " " & strTxt & "-" & Format(intN, "000") & ".xls" End Sub Sub HoleNr(strOrdner As String, strText As String, intMax As Integer) Dim objFSO As Object, objFol As Object, objFile As Object Dim intNr As Integer, strTn As String Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFol = objFSO.GetFolder(strOrdner) For Each objFile In objFol.Files 'abcd xyz 2006-04-556.xls If objFile.Name Like "* ####-##-###.xls" Then strTn = Left(Right(objFile.Name, 15), 7) Select Case strText Case strTn Case "": strText = strTn Case Is <> strTn intMax = -1 MsgBox "In '" & strOrdner & "' stehen Dateien zu verschiedenen Monaten.", _ vbCritical, "Abbruch" Exit Sub End Select intNr = Left(Right(objFile.Name, 7), 3) If intMax < intNr Then intMax = intNr End If Next objFile intMax = intMax + 1 End Sub

Beliebteste Forumthreads (12 Monate)

in Dateinamen fortlaufende Zahl einfügen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread