Automate Saving New File Version

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)
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
i = i + 1
End If

Exit Sub

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
Dim Teststr As String
On Error Resume Next
Teststr = Dir(FilePath)
On Error GoTo 0
If Teststr = “” Then
FileExist = False
FileExist = True
End If

End Function

Further Reading:
VBA Code to save as a new version if file already exists

Test if Folder, File or Sheet exists or File is open

SPLIT Function

InStrRev Function

MID Function