VBA Express : Excel - Incremental number for saved files

Excel

Incremental number for saved files

Ease of Use

Easy

Version tested with

2003

Submitted by:

tstav

Description:

Produce an incremental suffix for a filename e.g. file-1.xls, file-2.xls etc.

Discussion:

Before saving a file through code, we sometimes need to create an incremental filename on the fly in order to avoid overwriting a pre-existing file. We have to make sure that the new increment is unique even in the case of non-sequential pre-existing filenames e.g. file-1.xls, file-3.xls.

Code:

instructions for use

			Sub CreateNewFileName() 
     '--------------------------------------------------------------------------------
     'Produces an incremental FileName (if name is 'Data' it creates Data-1.xls)
     'Builds a suffix always one greater than the max suffix of any other potentially
     'existing files that have the same 'root' name, e.g. if 'Data.xls' and 'Data-2.xls'
     'exist, it creates Data-3.xls
     'Helps to avoid overwrite old files (among other uses)
     '--------------------------------------------------------------------------------
    Dim newFileName As String, strPath As String 
    Dim strFileName As String, strExt As String 
    strPath = "C:\AAA\" 'Change to suit
    strFileName = "Data" 'Change to suit
    strExt = ".xls" 'Change to suit
    newFileName = strFileName & "-" & GetNewSuffix(strPath, strFileName, strExt) & strExt 
    MsgBox "The new FileName is: " & newFileName 
     'Save copy
    ActiveWorkbook.SaveCopyAs strPath & newFileName 
End Sub 
 
Function GetNewSuffix(ByVal strPath As String, ByVal strName As String, ByVal strExt As String) As Integer 
    Dim strFile As String, strSuffix As String, intMax As Integer 
    On Error Goto ErrorHandler 
     'File's name
    strFile = Dir(strPath & "\" & strName & "*") 
    Do While strFile <> "" 
         'File's suffix starts 2 chars after 'root' name (right after the "-")
        strSuffix = Mid(strFile, Len(strName) + 2, Len(strFile) - Len(strName) - Len(strExt) - 1) 
         'FileName is valid if 1st char after name is "-" and suffix is numeric with no dec point
         'Skip file if "." or "," exists in suffix
        If Mid(strFile, Len(strName) + 1, 1) = "-" And CSng(strSuffix) >= 0 And _ 
        InStr(1, strSuffix, ",") = 0 And InStr(1, strSuffix, ".") = 0 Then 
             'Store the max suffix
            If CInt(strSuffix) >= intMax Then intMax = CInt(strSuffix) 
        End If 
NextFile: 
        strFile = Dir 
    Loop 
    GetNewSuffix = intMax + 1 
    Exit Function 
     
ErrorHandler: 
    If Err Then 
        Err.Clear 
        Resume NextFile 
    End If 
End Function

How to use:

Create a new XLS file or open an existing one. Press Alt-F11 to get into the VBEditor.
Copy the code to the general code module.
Save the file.

Test the code:

In the VBEditor, change the values of strPath, strFileName, strExt to suit your needs.
With the cursor resting inside the CreateNewFileName subroutine, hit F5.

Sample File:

Incemental FileName.zip 11.86KB

Approved by mdmackillop

This entry has been viewed 408 times.