VB and VBA Users Source Code: Creating a unique file name
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Creating a unique file name
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, November 11, 2002
Hits:
1580
Category:
Files/Directories/IO
Article:
Below is a routine which creates a unique indexed file name based on an input file name. Option Explicit 'Purpose : Returns a unique file name given an filename as a seed 'Inputs : sFilename The path and file name to be used as a seed. 'Outputs : Returns an unique indexed version of the filename from the input parameter "sFilename". ' Returns an empty file name on error. 'Author : Andrew Baker 'Date : 13/11/2000 10:14 'Notes : 'Revisions : Function FileNameGetUnique(sFileName As String) As String Dim lCount As Long, lPosDot As Long Dim sFileNoExtension As String, sExtension As String On Error GoTo ErrFailed If Len(sFileName) = 0 Then Debug.Assert "Error: Empty File name supplied to " & FileNameGetUnique Exit Function End If 'Remove file extension lPosDot = InStrRev(sFileName, ".") If lPosDot Then sFileNoExtension = Left$(sFileName, lPosDot - 1) sExtension = Mid$(sFileName, lPosDot) Else sFileNoExtension = sFileName End If 'Get unique file name Do lCount = lCount + 1 Loop While Len(Dir$(sFileNoExtension & "." & CStr(lCount) & sExtension)) FileNameGetUnique = sFileNoExtension & "." & CStr(lCount) & sExtension Exit Function ErrFailed: Debug.Print Err.Description Debug.Assert False FileNameGetUnique = "" End Function 'Demonstration routine Sub Test() Dim sFileName As String, sUniqueFileName As String sFileName = "C:\Filename.xls" sUniqueFileName = FileNameGetUnique(sFileName) MsgBox "The unique file name is " & sUniqueFileName End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
