davis1118
11-15-2017, 01:06 PM
I had very good results with this forum a few days ago with saving a backup copy into a new folder (thanks to Gmayor's awesome code), so I thought I would ask post another question. This is an extension of that same project, and I am stuck again. I have a macro saving a backup copy of the master file into a new folder called "Archive" and then it also saves a PDF version of the master document in the same directory as the master. Both of these functions are working fine. But my goal is to keep the name of the master file the same while only changing the footer during a save. This way I can link to the document without getting a broken link each save.
I am currently trying to automatically insert the "file name_current date" in the left footer along with the "Page x of y" in the center footer. I cannot believe how stuck I am with such a simple thing as inserting the footer, but I cannot figure it out after many searches and trials. I have it working in Excel with very minimal code, but Word is a whole new monster to me.
I did manage to find a macro to insert the "Page x of y", but the problem is when it's ran multiple times like it would if saved multiple times, then it keeps adding a new "Page x of y" into the footer.
Here is the code I'm currently using.
Sub FileSave()
On Error Resume Next
ActiveDocument.Save
BackupDoc ActiveDocument
lbl_Exit:
Exit Sub
End Sub
Private Sub BackupDoc(ByVal oDoc As Document)
'CENTER FOOTER
Dim rng As Range
With ThisDocument.Sections(1)
With .Footers(wdHeaderFooterPrimary)
Set rng = .Range.Duplicate
rng.Collapse wdCollapseEnd
rng.InsertBefore vbTab & "Page of "
rng.Collapse wdCollapseStart
rng.Move wdCharacter, 6
rng.Font.Size = 8
ThisDocument.Fields.Add rng, wdFieldPage
Set rng = .Range.Duplicate
rng.Collapse wdCollapseEnd
ThisDocument.Fields.Add rng, wdFieldNumPages
Dim myName As String
Dim ext As String
Dim myPath As String
Dim T As String
Dim fso As Object
If oDoc.Path = "" Then GoTo lbl_Exit
myName = Left(oDoc.Name, (InStrRev(oDoc.Name, ".") - 1))
ext = Right(oDoc.Name, Len(oDoc.Name) - InStrRev(oDoc.Name, "."))
myPath = ActiveDocument.Path & "\"
'SAVE AS PDF
ActiveDocument.ExportAsFixedFormat _
OutputFileName:=myPath & myName & ".pdf", _
ExportFormat:=wdExportFormatPDF
'SAVE IN ARCHIVE FOLDER
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(oDoc.Path & "\Archive") Then
fso.CreateFolder (oDoc.Path & "\Archive")
End If
T = Format(Now, "ddMmmyy hh mm ss")
fso.CopyFile oDoc.FullName, oDoc.Path & "\Archive\" & myName & "_" & T & "." & ext
lbl_Exit:
Set fso = Nothing
End With
End With
Exit Sub
End Sub
Hopefully I was clear enough with my issue, but please let me know if you need any clarification.
Thank you for the help. - David
I am currently trying to automatically insert the "file name_current date" in the left footer along with the "Page x of y" in the center footer. I cannot believe how stuck I am with such a simple thing as inserting the footer, but I cannot figure it out after many searches and trials. I have it working in Excel with very minimal code, but Word is a whole new monster to me.
I did manage to find a macro to insert the "Page x of y", but the problem is when it's ran multiple times like it would if saved multiple times, then it keeps adding a new "Page x of y" into the footer.
Here is the code I'm currently using.
Sub FileSave()
On Error Resume Next
ActiveDocument.Save
BackupDoc ActiveDocument
lbl_Exit:
Exit Sub
End Sub
Private Sub BackupDoc(ByVal oDoc As Document)
'CENTER FOOTER
Dim rng As Range
With ThisDocument.Sections(1)
With .Footers(wdHeaderFooterPrimary)
Set rng = .Range.Duplicate
rng.Collapse wdCollapseEnd
rng.InsertBefore vbTab & "Page of "
rng.Collapse wdCollapseStart
rng.Move wdCharacter, 6
rng.Font.Size = 8
ThisDocument.Fields.Add rng, wdFieldPage
Set rng = .Range.Duplicate
rng.Collapse wdCollapseEnd
ThisDocument.Fields.Add rng, wdFieldNumPages
Dim myName As String
Dim ext As String
Dim myPath As String
Dim T As String
Dim fso As Object
If oDoc.Path = "" Then GoTo lbl_Exit
myName = Left(oDoc.Name, (InStrRev(oDoc.Name, ".") - 1))
ext = Right(oDoc.Name, Len(oDoc.Name) - InStrRev(oDoc.Name, "."))
myPath = ActiveDocument.Path & "\"
'SAVE AS PDF
ActiveDocument.ExportAsFixedFormat _
OutputFileName:=myPath & myName & ".pdf", _
ExportFormat:=wdExportFormatPDF
'SAVE IN ARCHIVE FOLDER
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(oDoc.Path & "\Archive") Then
fso.CreateFolder (oDoc.Path & "\Archive")
End If
T = Format(Now, "ddMmmyy hh mm ss")
fso.CopyFile oDoc.FullName, oDoc.Path & "\Archive\" & myName & "_" & T & "." & ext
lbl_Exit:
Set fso = Nothing
End With
End With
Exit Sub
End Sub
Hopefully I was clear enough with my issue, but please let me know if you need any clarification.
Thank you for the help. - David