Microsoft Office Forums - View Single Post - Save document as new version with specific format

tanko · 04-03-2021, 08:56 PM

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