|
|
Имя файла по пути с новым номером (имеющийся + 1)
Public Function GetNewFileNo(sPath$, sFileMask$) As String
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")
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
|
|