Home > Back-end >  VBA: Automatically saving the excel sheet as V-1, V-2 and V-3 depending on if there is a file with t
VBA: Automatically saving the excel sheet as V-1, V-2 and V-3 depending on if there is a file with t

Time:05-23

I am working in VBA. I want to save the excel document with values from my sheet. However, repeats of the same file name can exist. If the same file name is repeated, I would like the VBA to save it as a different version number. For example, if the file name is CAT DOG and there is a second file saved as CAT DOG, I want the VBA to automatically save it as V-2. And if there is already a V-2, to than save if as V-3 and so on. This is the code I have so far. It saves great normally but I am having trouble with getting the version numbers added. I have attached an image of the code so far

''''

path = ""
filename1 = ws.Range("D5").Text & 
ws.Range("O3").Text`e`ws.Range("D6").Text
If filename1(path & filename1 & ".xlsm") = False Then
ActiveWorkbook.SaveAs Filename:=(path & filename1 & ".xlsm"), 
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Exit Sub
End If


Do While Saved = False
 If filename1(path & filename1 & x & ".xlsm") = False Then
  ActiveWorkbook.SaveAs Filename:=(path & filename1 & x & ".xlsm"), 
 FileFormat:=xlOpenXMLWorkbookMacroEnabled
  Saved = True
 Else
   x = x   1
 End If
Loop
 MsgBox "New file version saved (version " & x & ")"

CodePudding user response:

Do Not Overwrite Saved Files (Versioning)

  • Adjust the values in the constants section.

  • Using the current setup, it will create files with the following names:

    CAT DOG.xlsm
    CAT DOG (V-2).xlsm
    CAT DOG (V-3).xlsm
    etc.
    

    in the Test folder on drive C.

The Code

Option Explicit

Sub DoNotOverWrite()
    
    Const dFolderPath As String = "C:\Test\"
    Const dBaseName As String = "CAT DOG"
    Const dLeft As String = " (V-"
    Const dFirstNumber As Long = 2
    Const dRight As String = ")"
    Const dExtension As String = ".xlsm"
    
    Dim dFilePath As String: dFilePath = dFolderPath & dBaseName & dExtension
    Dim dFileName As String: dFileName = Dir(dFilePath)
    Dim n As Long: n = dFirstNumber - 1
     
    Do Until Len(dFileName) = 0
        n = n   1
        dFilePath = dFolderPath & dBaseName & dLeft & n & dRight & dExtension
        dFileName = Dir(dFilePath)
    Loop
    
    ' If the workbook is the one containing this code, use 'ThisWorkbook'.
    ActiveWorkbook.SaveAs dFilePath, xlOpenXMLWorkbookMacroEnabled
    
    If n < dFirstNumber Then
        MsgBox "File saved.", vbInformation
    Else
        MsgBox "New file version saved (version " & n & ")", vbInformation
    End If

End Sub
  • Related