I want to create a macro that will save a document as a new version. Documents in my company are named like "Master Agreement 01 (JPM 04.03.21)" where the "01" is the version number, "JPM" are the initials of the author, and of course "04.03.21" is the date.
I found the code at the bottom of this post on another site, and have been tinkering with it, but I keep getting thrown by InStrRev not finding a string with multiple variables. That is, I would think that the following code would return the version number in the above filename, but it does not.
Code:
Sub FileVerTest()
Dim VersionExt As String
Dim VerFind As String
Dim myFileName As String
myFileName = ActiveDocument.Name
VerFind = "[1-9] & Chr(0)"
'Finds version of current document, assuming doc is named like "[name] 01 ([initials] [date])"
VersionExt = Mid(myFileName, InStr(myFileName, VerFind, 2))
MsgBox VersionExt
End Sub
Why isn't this working? I've tried all kinds of VerFind strings, and nothing I do seems to make it work. I'm trying to learn VBA so I'd like to be able to write this one out, but I'm struggling.
Here is the code I found elsewhere that I would like to modify for this use. Also, here's a fun challenge, some people at my company use different formats like "Master Agreement02(JPM 04.03.21)" or "Master Agreement 02.1 (JPM 040321)". Once I get the basic code figured out, I think I can modify to meet each of those different naming styles.
Code:
Sub SaveNewVersion_Word()
'PURPOSE: Save file, if already exists add a new version indicator to filename
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long
Dim todayDate As String
Dim myInitials As String
myInitials = "DSR"
todayDate = Format(Date, "MM.DD.YY")
TestStr = ""
Saved = False
x = 2
'Version Indicator (change to liking)
VersionExt = "_v"
'Pull info about file
On Error GoTo NotSavedYet
myPath = ActiveDocument.FullName
myFileName = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
FolderPath = Left(myPath, InStrRev(myPath, "\"))
SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
On Error GoTo 0
'Determine Base File Name
If InStr(1, myFileName, VersionExt) > 1 Then
myArray = Split(myFileName, VersionExt)
SaveName = myArray(0)
Else
SaveName = myFileName
End If
'Test to see if file name already exists
If FileExist(FolderPath & SaveName & SaveExt) = False Then
ActiveDocument.SaveAs FolderPath & SaveName & SaveExt
Exit Sub
End If
'Need a new version made
Do While Saved = False
If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
ActiveDocument.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt
Saved = True
Else
x = x + 1
End If
Loop
'New version saved
MsgBox "New file version saved (version " & x & ")"
Exit Sub
'Error Handler
NotSavedYet:
MsgBox "This file has not been initially saved. " & _
"Cannot save a new version!", vbCritical, "Not Saved To Computer"
End Sub