CODEWITHSUNDEEP
vbams-wordformatting
Paul
Paul

Reputation: 1

Word Macro to insert footer

I'm looking to run a Word macro which inserts a footer with filename and date and page number.

The following macro inserts file name, date and page number in the body of the document. How to rewrite for it to insert this in the footer? Greatly appreciate your help :)

'AddFooter Macro

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
    "FILENAME  \p ", PreserveFormatting:=True
Selection.HomeKey Unit:=wdLine
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeText Text:=vbTab
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
    "PAGE  \* Arabic ", PreserveFormatting:=True
Selection.TypeText Text:=vbTab
Selection.InsertDateTime DateTimeFormat:="M/d/yyyy H:mm", InsertAsField:= _
    True, DateLanguage:=wdEnglishUS, CalendarType:=wdCalendarWestern, _
    InsertAsFullWidth:=False
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Size = 8
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.Font.Size = 8

End Sub`

Upvotes: 0

Views: 4121

Answers (3)

macropod
macropod

Reputation: 13515

Try:

Sub AddFooter()
With ActiveDocument.Sections.First.Footers(wdHeaderFooterPrimary).Range
  .Text = vbTab
  .Fields.Add Range:=.Characters.Last, Type:=wdFieldEmpty, Text:="PAGE", PreserveFormatting:=False
  .InsertAfter vbTab
  .Fields.Add Range:=.Characters.Last, Type:=wdFieldEmpty, Text:="DATE \@ ""M/D/YYYY H:mm""", PreserveFormatting:=False
  .InsertAfter vbCr
  .Fields.Add Range:=.Characters.Last, Type:=wdFieldEmpty, Text:="FILENAME  \p", PreserveFormatting:=False
End With
End Sub

Note1: To preserve any existing content, change '.Text = vbTab' to '.InsertAfter vbTab'.

Note2: To prevent the date changing later on, replace:

.InsertAfter vbTab
.Fields.Add Range:=.Characters.Last, Type:=wdFieldEmpty, Text:="DATE \@ ""M/D/YYYY H:mm""", PreserveFormatting:=False
.InsertAfter vbCr

with:

.InsertAfter vbTab & Format(Now,"M/D/YYYY H:mm") & vbCr

Upvotes: 0

openstepmedia
openstepmedia

Reputation: 3

I tried this:

Sub AddFooterText()
Dim Filename As String

Filename = ThisDocument.FullName

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Selection.TypeText Text:=Filename
Selection.TypeText Text:=" "
Selection.InsertDateTime DateTimeFormat:="M/d/yyyy H:mm"
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

Upvotes: 0

JohnChocsmith
JohnChocsmith

Reputation: 56

This is how I did it:

Sub AddFooter()

Dim Filename As String
Dim Sec As Section

Filename = ThisDocument.FullName

For Each Sec In ActiveDocument.Sections
    With Sec.Footers(wdHeaderFooterPrimary)
        .Range.InsertDateTime DateTimeFormat:="M/d/yyyy H:mm", InsertAsField:= _
            True, DateLanguage:=wdEnglishUS, CalendarType:=wdCalendarWestern
        .Range.Text = .Range.Text & Filename
        .PageNumbers.Add
    End With
Next Sec

End Sub

Upvotes: 1

Related Questions