jperri
asked on
Macro to add same footer to 50 different documents
I have to add the same footer "Rev. 12/19/03" to approx 50 different Word documents.
Some are two pages long, but most are only one page long. I'd like the footer to be on that last page only if possible.
Question: Is there VBA code that I could use to accomplish this task across all documents at once, without having to insert the footer into each file separately?
TIA!
JOrzech,
How are you putting the "Rev. 12/19/03" on the last page only? It has been about to give me fits. I had it all working and could not get just the last page. I was starting to look into the number of pages and on the last page set the ActiveDocument.Sections.Ap plication. Selection. HeaderFoot er.LinkToP revious = True
Do While sDoc <> ""
Set WdDoc = Documents.Open(sPath & sDoc)
InsertFooter
WdDoc.Save '<-- added so it will not promp
WdDoc.Close
sDoc = Dir
Loop
dragontooth
How are you putting the "Rev. 12/19/03" on the last page only? It has been about to give me fits. I had it all working and could not get just the last page. I was starting to look into the number of pages and on the last page set the ActiveDocument.Sections.Ap
Do While sDoc <> ""
Set WdDoc = Documents.Open(sPath & sDoc)
InsertFooter
WdDoc.Save '<-- added so it will not promp
WdDoc.Close
sDoc = Dir
Loop
dragontooth
Yes - sorry Dragontooth - he only wanted it on last page....
Never want to give you fits :)
Never want to give you fits :)
Place all the files in a directory and run this macro against them. Additional code is available if you are tracking changes or have these files password protected. Just let me know should you need that as well.
Sub Footer()
Application.ScreenUpdating = False
Set fs = Application.FileSearch
With fs
.LookIn = "H:\DATA\RMs" ' this is your directory
.SearchSubFolders = False
.FileName = "*.doc" ' assuming these are MS Word docs
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Documents.Open fs.FoundFiles(i)
ActiveWindow.ActivePane.Vi ew.SeekVie w = wdSeekCurrentPageFooter
Selection.WholeStory ' to type over any text already in the footer.
Selection.ParagraphFormat. Alignment = wdAlignParagraphCenter
Selection.Font.Name = "News Gothic MT" ' set up the font a size as you like
Selection.Font.Size = 8
Selection.TypeText Text:="Rev. 12/19/03"
ActiveDocument.Save
ActiveDocument.Close
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub
Sub Footer()
Application.ScreenUpdating
Set fs = Application.FileSearch
With fs
.LookIn = "H:\DATA\RMs" ' this is your directory
.SearchSubFolders = False
.FileName = "*.doc" ' assuming these are MS Word docs
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Documents.Open fs.FoundFiles(i)
ActiveWindow.ActivePane.Vi
Selection.WholeStory ' to type over any text already in the footer.
Selection.ParagraphFormat.
Selection.Font.Name = "News Gothic MT" ' set up the font a size as you like
Selection.Font.Size = 8
Selection.TypeText Text:="Rev. 12/19/03"
ActiveDocument.Save
ActiveDocument.Close
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I'm not sure who to award the points to!
What is the protocol for multiple answers?
First come, first served?
ASKER
85 points for JOrzech as well on main board!
Thank you jperri. Glad to have been of assistance. :)
Thank You jperri, for the Points and Grade!
Glad to been able to help! :)
dragontooth
Glad to been able to help! :)
dragontooth
https://www.experts-exchange.com/questions/20821221/Automatically-run-a-macro-on-a-number-of-Word-documents-in-a-folder.html
So you could want something like this (most code borrowed from above question):
Sub Test()
Dim sPath$, sDoc$, WdDoc As Word.Document
sPath = "C:\test\" 'Path with the docs
sDoc = Dir(sPath & "*.doc")
Do While sDoc <> ""
Set WdDoc = Documents.Open(sPath & sDoc)
InsertFooter
WdDoc.Close
sDoc = Dir
Loop
End Sub
Sub InsertFooter()
If ActiveWindow.View.SplitSpe
ActiveWindow.Panes(2).Clos
End If
If ActiveWindow.ActivePane.Vi
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.Vi
End If
ActiveWindow.ActivePane.Vi
If Selection.HeaderFooter.IsH
ActiveWindow.ActivePane.Vi
Else
ActiveWindow.ActivePane.Vi
End If
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"IF ", PreserveFormatting:=True
ActiveWindow.View.ShowFiel
Selection.HomeKey Unit:=wdLine
Selection.MoveRight Unit:=wdWord, Count:=2
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"PAGE ", PreserveFormatting:=True
Selection.TypeText Text:=" = "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"NUMPAGES ", PreserveFormatting:=True
Selection.TypeText Text:=" ""Rev. 12/19/03"" """""
Selection.EndKey Unit:=wdLine
ActiveWindow.ActivePane.Vi
End Sub