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 driveC
.
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