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:

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

Test the code:

  1. In the VBEditor, change the values of strPath, strFileName, strExt to suit your needs.
  2. 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 500 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2014 VBA Express