Volgend factuurnr bepalen a.d.h.v. reeds bestaande factuurnummers in een map

[Gert Bouwmeeste]

Ik, maar ook anderen, maken facturen in Excel. Die worden in één specifieke map geplaatst, zeg "C:\Bedrijf\Verzonden facturen\2011". De bestandsnamen van alle facturen beginnen (voor dit jaar) met "2011- gevolgd door 3 cijfers. Met deze code lukt het om de XLS-bestanden in de betreffende map uit te lezen, daar het factuurnr uit te halen en die in een numerieke lijst te zetten vanaf cel A3.

Sub ZoekAlleBestanden()
Dim ZoekMap As String
Dim i As Long
Dim fs As Object
Dim fl As Object

ZoekMap = "C:\DATA\BOUWMEESTER VERSPREIDINGEN\Verzonden Facturen\2011"

Set fs = CreateObject("Scripting.FileSystemObject")


With Application.FileSearch
.NewSearch
.LookIn = ZoekMap
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = True

Range("A3").Select
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If i = 1 Then Range("A3").Select
Cells(i + 2, 1) = Right(Left(Right(.FoundFiles(i), Len(.FoundFiles(i)) - Len(ZoekMap) - 1), 8), 3)
Next i
End If
End With

End Sub

Maar hoe krijg ik het nu voor elkaar dat ik uit die lijst de grootste selecteer en die met 1 verhoog? Ik ken de werkbladfunctie MAX wel, maar ik wil het graag in de macro inbouwen.

 

[jverkerk]

Option Explicit
Const MijnPad = "C:\Users\Johan\Desktop\Facturen\"                             'directory waar de facturen staan

Sub tst()
  Dim Nr As Integer, Pad As String, c1 As String, x As String, Naam As String, i As Integer
  Dim Omschr As String
  Omschr = "B" & Year(Date) & "-"                          'zoek naar factuurnrs van het huidige jaar
  Pad = MijnPad & IIf(Right(MijnPad, 1) <> "\", "\", "")
  c1 = Dir(Pad & Omschr & "*.xlsm*")                        'zoek xls-files (en xlsm,xlsx, ...) die beginnen met bovenstaande omschrijving
  Do Until c1 = ""                                         'zoeken tot je alle files langsgelopen hebt
    x = Replace(c1, Omschr, "")                            'verwijder omschrijving
    i = InStr(1, x, ".xlsm")                                'nu nog de file-extensie
    If i > 0 Then x = Left(x, i - 1)
    If IsNumeric(x) Then                                   'is wat overblijft nog numeric
      Nr = WorksheetFunction.Max(Nr, CInt(x))              'zoek hoogste nummer tot nogtoe
    End If
    c1 = Dir
  Loop

  Naam = Omschr & Format(Nr + 1, "000")                    'naam van de factuur (voor het geval je max. 999 facturen per jaar maakt
  [Blad1!A1].Value = Naam
  ThisWorkbook.SaveAs Pad & Naam & ".xlsm"
  Workbooks.Open (Pad & "Origineel factuur.xlsm")
  ThisWorkbook.Close
End Sub

Deze werkt dat weet ik zeker, ik heb hem niet gemaakt want dat kan ik niet.
Nr. in A1 B2011-001

 

[Gert Bouwmeeste]

Nr = WorksheetFunction.Max(Nr, CInt(x))

Deze zocht ik