Office: (Office 2013) fortl Rechnungsnummer

haklesoft · 28. Januar 2021

von MicMay

gibt es hier eine Lösung das er auch wenn man neue Ordner erstelt die mit durchsucht ohne sie hinzuzufügen? sowas wie "*\"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Klar könnte man das machen. Entspricht aber nicht Deiner Aufgabenstellung in #27. Solche Umstellungen werden hier nicht gern gesehen, denn es bedeutet oft, dass Helfer eine Lösung umsonst entwickelt haben.

Zum Durchsuchen ganzer Verzeichnisbäume gibt es hier reichlich Beispiele, die Du adaptieren könntest. Ich bin heute nicht am PC. Da müsstest Du ggf. warten, wenn Du es nicht selbst hinkriegst.

haklesoft · 18. November 2016

Hier nun eine Variante, die alle existierenden Unterordner zum Ermitteln der nächsten freien Dateinummer mit durchsucht: Code:

Option Explicit

Sub Document_New()
' das Array nimmt den Fullname und die Kern-Angebotsnummer auf
Dim sFileName(0 To 1) As String
' diese Function füllt das Array
If nextFilename(sFileName()) True Then Exit Sub

' wenn man Vertrauen in den Ablauf bekommen hat,
' kann man getrost auf diese Kontrolle verzichten:
MsgBox "Dokumentenname: " & sFileName(0) & vbLf & _
"Angebotsnummer: " & sFileName(1), vbInformation, _
"Dokumentenname und Angebotsnummer"

With ActiveDocument
' Dateiname und Kernnummer in Tabelle eintragen - ggf. aktivieren
' .Tables(1).Rows(1).Range.Text = sFileName(0)
.Tables(1).Rows(2).Range.Text = sFileName(1)

' Dokument unter dem erzeugten Dateinamen im Basispfad speichern
.SaveAs sFileName(0)
End With
End Sub

' füllt das übergebene String-Array mit den gesuchten Werten
' liefert True bei fehlerfreiem Durchlauf
Private Function nextFilename(ByRef saFile() As String) As Boolean
On Error GoTo nextFilenameErr
Dim sAblage As String, sJahr As String, sDocExt As String
Dim c As Integer, i As Integer
Dim sName As String, iNr As Integer
Dim objFSO As Object
Dim colOrdner As New Collection

Const csRE As String = "Angebotsnummer-"

' Basisablagepfad für zu durchsuchende Verzeichnisse benennen (ohne abschließenden Backslash)
sAblage = Environ("USERPROFILE") & "\Desktop\Angebote"

' aktuelles Jahr feststellen
sJahr = Year(Date) & "-"
' Dateiextender bestimmen
sDocExt = IIf(Val(Application.Version) > 11, ".docx", ".doc")

Set objFSO = CreateObject("Scripting.FileSystemObject")
listFolders objFSO, sAblage, colOrdner

' höchste Nummer über Basis- und Unterpfade ermitteln
For i = 1 To colOrdner.Count
sName = Dir(colOrdner(i) & "\" & csRE & sJahr & "????" & sDocExt)
Do While sName vbNullString
iNr = CInt(Mid$(sName, InStr(1, sName, sDocExt, vbTextCompare) - 4, 4))
If iNr > c Then c = iNr
sName = Dir
Loop
Next

c = c + 1 'freie Nummer festlegen
If c < 1001 Then c = c + 1000
' Basisablagepfad und ermittelten freien Dateinamen eintragen
saFile(0) = sAblage & "\" & csRE & sJahr & c & sDocExt
' Kern-Angebotsnummer eintragen
saFile(1) = sJahr & c
nextFilename = True

Exit Function

nextFilenameErr:
MsgBox Err.Description & vbCrLf & vbCrLf & _
sAblage & sJahr & c & sDocExt, vbCritical, _
"Dateifehler " & Err.Description

End Function

' listet in einer Collection alle Verzeichnisse auf
Private Sub listFolders(ByRef oFSO As Object, ByVal sPath As String, ByRef colFolders As Collection)
Dim vSuFo As Variant
colFolders.Add sPath
For Each vSuFo In oFSO.GetFolder(sPath).SubFolders
Call listFolders(oFSO, vSuFo.Path, colFolders)
Next
Set vSuFo = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

MicMay · 22. November 2016

Super Danke für die Lösung ist perfekt damit ich beruhigt in Urlaub gehen kann.
Entschuldige das ich jetzt erst antworte

officesnoopy · 12. Oktober 2017

Ich denke, der Test von "Word-Print-Buttons Add-In" auf Word-Print-Buttons zahlt sich auf jeden Fall aus.
Kann seit neuestem auch einmalige Rechnungsnummern etc. einfügen.

Office: (Office 2013) fortl Rechnungsnummer

fortl Rechnungsnummer

fortl Rechnungsnummer

fortl Rechnungsnummer

fortl Rechnungsnummer - Similar Threads - fortl Rechnungsnummer

Lieferscheine nach Rechnungsnummern zusammenrechnen

rechnungsnummern

Rechnungsnummer fortlaufend

Rechnungsnummer mit Jahr und Nummer erzeugen

Rechnungsnummer isolieren

Automatische Rechnungsnummer

Fortlaufende Rechnungsnummer (1/12,2/12 ...)