[Tasos]

Φίλε Γιώργο καλησπέρα!

Παραλίγο να σε ξεχάσουμε!
O Γιάννης (nisgia) κι εγώ, καταλήξαμε στις παρακάτω λύσεις για το ζητούμενο σου.

Λύση 1:

Function GetNewFilePrefix(ByVal strPath As String) As String
    Dim objFiles As Object
    Dim objFile As Object
    Dim strTemp As String
    Dim intMax As Integer

    With CreateObject("Scripting.FileSystemObject")
        If .FolderExists(strPath) Then
            Set objFiles = .GetFolder(strPath).Files
            For Each objFile In objFiles
                strTemp = objFile
                If objFile.Type = "Microsoft Excel Worksheet" Then
                    strTemp = Mid(.GetFileName(strTemp), 1, 4)
                    If strTemp Like "###_" Then
                        If CInt(Left(strTemp, 3)) > intMax Then
                            intMax = CInt(Left(strTemp, 3))
                        End If
                    End If
                End If
            Next objFile
        Else
            MsgBox "Invalid Path!", vbExclamation
        End If
    End With
    GetNewFilePrefix = Format(intMax + 1, "000_")
End Function

Λύση 2:

Function NextFreeName(strPath$, strFile$) As String
    Dim strEnum%, sFile$
    strPath = strPath & IIf(Right(strPath, 1) <> "\", "\", "")
    sFile = Dir(strPath & "*" & strFile, vbNormal)
    Do Until sFile = ""
        strEnum = Application.Max(strEnum, IIf(IsNumeric(Left(sFile, 3)), Left(sFile, 3), 0))
        sFile = Dir
    Loop
    NextFreeName = strPath & IIf(strEnum = 0, "001_", _
            Format(strEnum + 1, "000_")) & strFile
End Function

Δες και το συνημμένο παράδειγμά (με τη δεύτερη λύση).

Ελπίζω να σε καλύψαμε!

Φιλικά

Τάσος