Microsoft Office Macros

Increment revN at the end of the filename of the current file and save it.

IncrAndSave.vba

Sub IncrAndSave()
'
' Increment the revision number and save
'
'    ActiveDocument.Name
    Dim myfilename, currentfilename, nstr, newno, x, y, z As String
    Dim a, b, c, n As Integer
    Dim rev As Boolean
 
    ' this strips the extension from the filename
    currentfilename = CreateObject("scripting.filesystemobject").getbasename(ActiveDocument.Name)
    Set Regexp = CreateObject("VBScript.RegExp")
    Regexp.Pattern = "[0-9]+$"
    Set Matches = Regexp.Execute(currentfilename)
    rev = False
    For Each Match In Matches
        rev = True
        n = Match
        nstr = Match
    Next
    If rev Then
        myfilename = Mid(currentfilename, 1, Len(currentfilename) - Len(nstr))
        newno = n + 1
        myfilename = ActiveDocument.Path & "\" & myfilename & newno
'       MsgBox "Saving current file to " & myfilename
    Else
        myfilename = ActiveDocument.Path & "\" & currentfilename & " rev1"
    End If
    ActiveDocument.SaveAs filename:=myfilename, FileFormat:= _
            wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
            :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
            :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
            SaveAsAOCELetter:=False
End Sub

SaveCopyEdit.vba

Sub SaveCopyEdit()
'
' SaveCopyEdit Macro
'
'
'    ActiveDocument.Name
    Dim myfilename As String
    myfilename = "D:\slack\rwanda\copy edit\" & CreateObject("scripting.filesystemobject").getbasename(ActiveDocument.Name) & " revDH.docx"
'    MsgBox myfilename
    Application.StatusBar = "Saving to copy edit folder..."
    ActiveDocument.SaveAs filename:=myfilename, FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
    ActiveDocument.SaveAs
    ActiveDocument.TrackRevisions = True
'    ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions
End Sub