Private Sub Form_Click()
Dim sFullFileName As String
Dim myStr As String
Dim cntr As Long
sFullFileName = "MyPicture.jpeg"
'sFullFileName = "MyPic.jpg"
myStr = sFullFileName
myStr = FileNameIncrement(myStr, "_") 'You could chg optional length from 3 to 4, by passing 4
Print myStr
For cntr = 0 To 11
myStr = FileNameIncrement(myStr, "_")
Print myStr
Next cntr
End Sub
'This pads the suffix(Incr), so that viewing of file names will be chronological.
'This will append say "_001"
'If you pass one with say "_003", then you'll get "_004" back
Public Function FileNameIncrement(sIN As String, Optional sSep As String = "_", Optional lenIncr As Long = 3) As String
'Author: Rob Crombie
Dim sFn As String ' MyPic
Dim sFnIncr As String ' 001 or 0001 or 00001
Dim sFnIncrMaybe As String
Dim lFnIncr As Long
Dim sFnExt As String ' .jpg or .jpeg
Dim sArr() As String
Dim sWork As String ' Working pad
Dim sWork2 As String ' Working pad
'Dim lLen As Long ' Usually 3 may be 4 (mutter, mutter)
Dim bVirgin As Boolean ' Lacks any previous incrementing
Dim sMsg As String
Dim sTitle As String
If InStr(sIN, ".") = 0 Then
sMsg = ""
sMsg = sMsg & " Please give full file name, including the extension" & vbCrLf
sMsg = sMsg & " An example would be MyPic.jpg"
sTitle = " YOU MUST ALSO INCLUDE THE FILE EXTENSION"
MsgBox sMsg, , sTitle
Exit Function '<== Exit Function
End If
sArr = Split(sIN, ".")
sWork = sArr(0) ' sWork contains everything to the left of the .
sFnExt = sArr(1) ' Contains say jpg
'Perhaps it hasn't been here before ?
If InStr(1, sWork, sSep) = 0 Then
'Definitely has never been appended
bVirgin = True
Else
'It contains sSep, but may just be part of file name ?
' sWork contains everything to the left of the .
sArr = Split(sWork, sSep)
sFnIncrMaybe = sArr(UBound(sArr))
If Len(sFnIncrMaybe) <> lenIncr Then
bVirgin = True
Else
'The sSep was in the correct place, but it may not be our sSep ?
' I'll assume that sSep & nnn is ours
If IsNumeric(sFnIncrMaybe) = True Then
'Lets convert it, and increment it, whilst we know what we are doing.
lFnIncr = CLng(sFnIncrMaybe) + 1
Else
bVirgin = True
End If
End If
End If
If bVirgin Then
'If it is a virgin, our job is easy. Just append say _001
FileNameIncrement = sWork & sSep & PadLeft("1", lenIncr, "0") & "." & sFnExt
Exit Function '<== Exit Function
Else
'It had a suffix like 006, so make that 007 instead
'sWork = MyPic_001 we want sFn = MyPic
sFn = Left(sWork, Len(sWork) - (lenIncr + 1))
'Convert the just incremented number to a string and pad it in front with 0
sWork2 = CStr(lFnIncr) '<== This may contain say 6, if it was _006
' Typically MyPic _ say 6 3 Pad chr
FileNameIncrement = sFn & sSep & PadLeft(sWork2, lenIncr, "0") & "." & sFnExt
End If
End Function
Public Function PadLeft(sIN As String, lngLen As Long, Optional sChar As String = " ") As String
'Author: Rob Crombie
Dim sPad As String
Dim i As Long
If Len(sIN) > lngLen Then
MsgBox "Passed string was too long. already", , "ERROR IN CODE THAT CALLED PadLeft"
Exit Function '<===== Exit Function
End If
'If "" was passed, then assume they meant " "
If Len(sChar) = 0 Then
sChar = " "
End If
For i = 1 To (lngLen - Len(sIN))
sPad = sPad & sChar
Next i
PadLeft = sPad & sIN
End Function
