Anzeige
Archiv - Navigation
1108to1112
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Datei mit nächst höherer laufender Nummer speicher

Datei mit nächst höherer laufender Nummer speicher
Joni
Hallo,
ich bin auf der Suche nach einer Möglichkeit Dateien mittels Makro mit einer laufenden Nummer zu speichern. Die laufende Nummer soll aus den bereits im Ordner vorhandenen Dateien ermittelt werden und dann die nächst höher Nummer für den Dateinamen verwendet werden.
laufende Nummer zB 00001
Text zB Rechnung
Datum zB 2009-10-13
Endung zB PDF
= "00001 Rechnung 2009-10-13.pdf"
Wie könnte ich das Lösen?
Danke für eure Hilfe.
Gruß Joni

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Datei mit nächst höherer laufender Nummer speicher
14.10.2009 02:07:49
fcs
Hallo Joni,
hier ein Beispiel erstellt unter Excel 2007.
Sollte bis auf die Ausgabe des Blattes als PDF-Datei auch unter Excel 2003 funktionieren.
Gruß
Franz
'Erstellt unter Excel 2007, Windows Vista
Sub Next_PDF_File_Number()
Dim Nummer As Long, strDateiname As String, Anzahl_Ziffern As Long
Anzahl_Ziffern = 5 'Anzahl Ziffern in Zählnummer
'Ermittlung der nächsten Zählnummer - Verzeichnis und Dateityp anpassen!!
Nummer = fncLastNumber(strVerzeichnis:="C:\Users\Public\Test", _
AnzZiffern:=Anzahl_Ziffern, DateiTyp:="pdf") + 1
'Dateiname generieren
strDateiname = Format(Nummer, String(Anzahl_Ziffern, "0")) & " Rechnung " _
& Format(Date, "YYYY-MM-DD") & ".pdf"
MsgBox "Nächster Dateiname: " & strDateiname ' Testzeile
'Aktives Blatt als PDF-Datei speichern und anzeigen
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strDateiname, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
Function fncLastNumber(strVerzeichnis As String, AnzZiffern As Long, _
Optional DateiTyp As String = "*") As Long
Dim strDatei As String
'Ermittlung der höchsten Zählnummer in den Dateinamen des Verzeichnisses
strDatei = Dir(strVerzeichnis & Application.PathSeparator & "*." & DateiTyp)
Do Until strDatei = ""
If IsNumeric(Left(strDatei, AnzZiffern)) Then
If CLng(Left(strDatei, AnzZiffern)) > fncLastNumber Then
fncLastNumber = CLng(Left(strDatei, AnzZiffern))
End If
End If
strDatei = Dir
Loop
End Function

Anzeige
Danke und mein Weg nach Rom
19.10.2009 12:37:34
Joni
Hallo Franz,
danke für deine Lösung. Die funktioniert genau so wie ich sie brauche. Auch ich war auf der Suche nach einem Weg nach Rom erfolgreich und habe diesen zwischenzeitlich gewählt (filesystemobject).
For Each file In ordner.Files
teil = Left(file.Name, 5)
teil = teil + 10000 '+10000 damit 5 Stellen vorhanden sind für die weitere Bearbeitung
endung = Right(file.Name, 4)
If teil > max Then max = teil
Next
max = max + 1 - 10000 '10000 wieder weg
max = Format$(max, "00000") 'auf 5 Stellen formatieren
nameneu = speicherort & max & text & tagdat & endung 'Name neu inkl. Pfad
Nochmal Danke
Gruß Joni
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige