Word (VBA) Dokument mit fortlaufender Nummer+aktuellem Datum erstellen?

3 Antworten

Mauritan
Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer
Computer
28.01.2021, 08:39

Wenn ich das recht verstanden habe, dann orientiert sich Deine Eingabe jeweils am "current date", also dem heutigen Datum.

VBA habe ich schon lange nicht mehr gemacht, es sollte "Date" sein, das das tut. Heißt für Dich: Ersetze Date durch jenes Datum, das Dein Ausgangspunkt sein soll.

Hinweis: Intern wird das Datum als Zahl gespeichert, die von 1.1.1900 hochgezählt wird, also z.B.: 44550. Du kannst diese Zahl sicher im Internet nachschlagen lassen oder Dir anzeigen, indem Du eine Datum in einer Zelle umformatiert als Zahl.

Davon zählst Du dann hoch.
Woher ich das weiß:Berufserfahrung – ich arbeite schon sehr lange im EDV Bereich, viele Sparten
Tobbess
31.01.2021, 21:54

Hi, zunächst Danke fürs Feedback... leider komme ich aber mit deinem Vorschlag nicht weiter.

Aktuell -und Anlass meiner Frage - habe ich folgendes Szenario:

Protokoll 1: 001-30.01.2021

Protokoll 2: 002-30.01.2021

Protokoll 3: 001-31.01.2021 --> soll sein: 003-31.01.2021

Beim Öffnen der Vorlage soll also nur die Laufnummer abgefragt werden und dann +1 gezählt werden.

Für weitere Hilfestellungen bin ich absolut dankbar!

P.S. Ich bin kein VBA Profi

Danke
geri3d
Nutzer, der sehr aktiv auf gutefrage ist
im Thema programmieren
01.02.2021, 04:31

Das Problem an dem Script ist diese Stelle hier:

    'ersten freien Dateinamen ermitteln
    c = 1
    sIstDa = Dir(sAblage & Format(c, "000") & sVorgabe & sDocExt)
    While sIstDa <> ""
        c = c + 1
        sIstDa = Dir(sAblage & Format(c, "000") & sVorgabe & sDocExt)
    Wend

Es macht exakt was es soll: Prüfe fortlaufend die Nummern 001 - 999 und wenn der Dateinmane NICHT vorhanden ist wird die Schleife unterbrochen.

Das ist leider sehr schlampig programmiert und führt genau zu diesem Fehler.

Lösungsansatz wäre im angegebenen Verzeichnis alle Dateien aufzulisten und von jeder Datei die Nummer herausfischen mit den Stringmethoden Left, Right, Mid, InStr, InStrRev und Len aber nicht das Datum und wenn du durch alle Dateien iteriert hast kannst du mit Hilfe von sowas:

If c > nummerDateiname then
    nummerDateiname = c
End If

ermitteln welche die höchste Zahl ist. Dann sollte der Wechsel des Datums kein Problem mehr sein.

Im Idealfall sind alle Dateinamen gleich aufgebaut.
Woher ich das weiß:eigene Erfahrung
geri3d  01.02.2021, 08:32

So könnte das aussehen:

Sub NeueDateiNummer()

'Deklaration
Dim c As Integer
Dim nummerDateiname As Integer
Dim sFolder As String
Dim sNummer As String
Dim objFileSystem As Object
Dim objVerzeichnis As Object
Dim objDateienliste As Object

'Dieser Teil kann ausgelassen werden wenn der Pfad im Code steht
'---------------------------------------------------------------
MsgBox "Wählen Sie den Pfad.", vbInformation, "Pfad EIngeben"
' Open the select folder prompt
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then ' if OK is pressed
        sFolder = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With
'---------------------------------------------------------------


' \ anhängen
If Right(sFolder, 1) <> "\" Then
    sFolder = sFolder & "\"
End If

'FileSystem Objekte füllen
Set objFileSystem = CreateObject("scripting.FileSystemObject")
Set objVerzeichnis = objFileSystem.GetFolder(sFolder)
Set objDateienliste = objVerzeichnis.Files

For Each objDatei In objDateienliste
    sFileName = objDatei.Name
    If InStr(1, sFileName, "-") Then
        sNummer = Left(sFileName, InStr(1, sFileName, "-") - 1)
        If IsNumeric(sNummer) Then
            c = Val(sNummer)
        End If
        If c > nummerDateiname Then
            nummerDateiname = c
        End If
    End If
Next objDatei

nummerDateiname = nummerDateiname + 1
    
MsgBox sFolder & Format(nummerDateiname, "000") & "-" & Format(Date, "dd.MM.yyyy")
    
End Sub
0