How to automate the process of saving an existing file as a new version so that it is not overwritten.
Watch the training tutorial video below:
Here’s the complete VBA code to save an existing file as a new version:
Option Explicit
Sub SaveFileAsNewVersion()
Dim myFolderPath As String
Dim myPath As String
Dim Savename As String
Dim myVersion As String
Dim saveext As String
Dim Saved As Boolean
Dim i As Long
Dim Teststr As String
Dim myFileName As String
Dim myarray As Variant
Teststr = “”
Saved = False
i = 1
‘version marker
myVersion = “_ver”
‘Get info about our existing file
On Error GoTo NotYetSaved
myPath = ActiveWorkbook.FullName
myFileName = Mid(myPath, InStrRev(myPath, “\”) + 1, InStrRev(myPath, “.”) – InStrRev(myPath, “\”) – 1)
myFolderPath = Left(myPath, InStrRev(myPath, “\”))
saveext = “.” & Right(myPath, Len(myPath) – InStrRev(myPath, “.”))
On Error GoTo 0
If InStr(1, myFileName, myVersion) >= 1 Then
myarray = Split(myFileName, myVersion)
Savename = myarray(0)
Else
Savename = myFileName
End If
If FileExist(myFolderPath & Savename & saveext) = False Then
ActiveWorkbook.SaveAs myFolderPath & Savename & saveext
Exit Sub
End If
Do While Saved = False
If FileExist(myFolderPath & Savename & myVersion & i & saveext) = False Then
ActiveWorkbook.SaveAs myFolderPath & Savename & myVersion & i & saveext
Saved = True
Else
i = i + 1
End If
Loop
Exit Sub
NotYetSaved:
MsgBox “This file has never been saved.” & _
“Therefore cannot save as a new version!”, vbCritical, “Not saved!”
End Sub
Function FileExist(FilePath As String) As Boolean
‘Reference: http://www.rondebruin.nl/win/s9/win003.htm
Dim Teststr As String
On Error Resume Next
Teststr = Dir(FilePath)
On Error GoTo 0
If Teststr = “” Then
FileExist = False
Else
FileExist = True
End If
End Function
Further Reading:
VBA Code to save as a new version if file already exists