Generates new available file name for a certain file in order to duplicate it, this does not duplicate the file, it just generate name for it, making sure new file name does not exist using Dir command.
No change if sFileName file was not found, allowing to use this empty slot.
Sepa2 is the separator between filename and numeric counter after it, default to space
Function DuplicateFilename(sFileName, Sepa2)
Dim lCount, lPosDot, sFileNoExtension, sExtension
' Sepa2 is the separator between filename and numeric counter after it
DuplicateFilename = ""
If Sepa2 = "" Then Sepa2 = " " ' Default separator to space
If Len(sFileName) = 0 Then Exit Function
sFileNoExtension = sFileName
lPosDot = InStrRev(sFileName, ".") ' Remove file extension
If lPosDot Then
sFileNoExtension = Left$(sFileName, lPosDot - 1)
sExtension = Mid$(sFileName, lPosDot)
End If
lCount = 0
' Check if filename already has number at end, after last space
sFileNoSpace = sFileNoExtension
lPosSpace = InStrRev(sFileNoExtension, Sepa2)
If lPosSpace Then
sFileNoSpace = Left$(sFileNoExtension, lPosSpace - 1)
lCount = Fix(Mid$(sFileNoExtension, lPosSpace))
End If
sCount = ""
If lCount > 0 Then sCount = Sepa2 & CStr(lCount)
Do While Len(Dir$(sFileNoSpace & sCount & sExtension)) ' Add number after filename, before extension
lCount = lCount + 1
sCount = Sepa2 & CStr(lCount)
Loop
DuplicateFilename = sFileNoSpace & sCount & sExtension
End Function
Dim lCount, lPosDot, sFileNoExtension, sExtension
' Sepa2 is the separator between filename and numeric counter after it
DuplicateFilename = ""
If Sepa2 = "" Then Sepa2 = " " ' Default separator to space
If Len(sFileName) = 0 Then Exit Function
sFileNoExtension = sFileName
lPosDot = InStrRev(sFileName, ".") ' Remove file extension
If lPosDot Then
sFileNoExtension = Left$(sFileName, lPosDot - 1)
sExtension = Mid$(sFileName, lPosDot)
End If
lCount = 0
' Check if filename already has number at end, after last space
sFileNoSpace = sFileNoExtension
lPosSpace = InStrRev(sFileNoExtension, Sepa2)
If lPosSpace Then
sFileNoSpace = Left$(sFileNoExtension, lPosSpace - 1)
lCount = Fix(Mid$(sFileNoExtension, lPosSpace))
End If
sCount = ""
If lCount > 0 Then sCount = Sepa2 & CStr(lCount)
Do While Len(Dir$(sFileNoSpace & sCount & sExtension)) ' Add number after filename, before extension
lCount = lCount + 1
sCount = Sepa2 & CStr(lCount)
Loop
DuplicateFilename = sFileNoSpace & sCount & sExtension
End Function
sFileName, Sepa2
' ' Demonstration routine
' ' Sub Test()
' ' Dim sFileName As String, sUniqueFileName As String
' ' sFileName = "C:\Filename.xls"
' ' sUniqueFileName = DuplicateFilename(sFileName, "")
' ' MsgBox "The unique file name is " & sUniqueFileName
' ' End Sub
' ' Sub Test()
' ' Dim sFileName As String, sUniqueFileName As String
' ' sFileName = "C:\Filename.xls"
' ' sUniqueFileName = DuplicateFilename(sFileName, "")
' ' MsgBox "The unique file name is " & sUniqueFileName
' ' End Sub
Views 4,520
Downloads 1,375
CodeID
DB ID