DuplicateFileName

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

CodeFunctionName
What is this?

Public

Tested

Imported
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

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

Views 4,520

Downloads 1,375

CodeID
DB ID

ANmarAmdeen
602
Attachments
Revisions

v1.0

Saturday
July
7
2018
Needs