Имя файла по пути с новым номером по фиксированной маске

Public Function GetNewFileNo(sPath$, sFileMask$) As String

'Возвращает имя файла по пути с новым номером по фиксированной маске ???? (4 символа строго)

'ВНИМАНИЕ!!! - Проверка существования папки сохранения не прозводится.

'--------------------------------------------------------------------------

Const iMaskLen% = 4 'Длинна маски номера файла - Тут фиксировано для упрощения кода

Dim iMaskStart% 'Начало маски

Dim iMaxNo% 'Максимальный номер файла

Dim s$, sTemp$, iTempNo% ' Вспомогательные

'--------------------------------------------------------------------------

On Error GoTo GetNewFileNo_Err

If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

iMaskStart = InStr(1, sFileMask, "?") ' Получаем начало маски

'Перебор файлов в папке:

s = Dir(sPath & sFileMask, vbNormal)

Do While s <> ""

sTemp = Mid(s, iMaskStart, iMaskLen) ' Номер файла из пути

iTempNo = CInt(sTemp) ' Преобразуем в число для сравнения

If iTempNo > iMaxNo Then iMaxNo = iTempNo ' Оперируем номером .... получаем максимальный

s = Dir

Loop

sTemp = String(iMaskLen, "0") 'формат маcки

s = Format(iMaxNo + 1, sTemp)

' Формируем новое название файла

GetNewFileNo = sPath & Mid(sFileMask, 1, iMaskStart - 1) & s & Mid(sFileMask, iMaskStart + iMaskLen)

GetNewFileNo_Bye:

Exit Function

GetNewFileNo_Err:

MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & "в процедуре: GetNewFileNo", vbCritical, "Error in module Module1"

Resume GetNewFileNo_Bye

End Function

Проверочка:

Public Sub Test01()

Dim s$

s = "Имя_файла_????.xls"

Debug.Print GetNewFileNo("D:\Temp2\", s) & " = а вот и результ!"

End Sub