Uploaded February 2020 | Updated September 2026, 2 weeks ago

---

How to automate the process of saving an existing file as a new version so that it is not overwritten.
Here's the complete VBA code:
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) NOTGREATERTHAN(Use Symbol)= 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
You can also refer to the website link for more ideas: exceltrainingvideos.com/automate-saving-new-file-version