uups nun mit code

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