For existing documents, this is not entirely straightforward as there can be
many sections and associated different footers in a document, some of which
may already have content.
For new documents it might be better to simply insert the required fields in
the document template (not the normal template) and intercept the FileSave
and FileSaveAs commands to add code to update the filename field. However
sticking with the question ....
The default footer style in the normal template has a centre tab and a right
aligned tab already included, so I will work on the premise that you still
have that style with the default tabs in your document - otherwise you will
need to restore it. Document paths can be long so having three elements on
the same line can produce some unusual effects, so I have set the font size
to 10 points to minimise the potential for wrapping..
The following will open a new document, force a save and add the required
footer
Dim oDoc As Document
Dim oRng As Range
Dim oSection As Section
Dim oFooter As HeaderFooter
Dim sPath As String
Dim sDate As String
Set oDoc = Documents.Add
With oDoc
If Len(.Path) = 0 Then .Save
sDate = Format(Date, "d MMM yyyy")
sPath = .FullName
For Each oSection In .Sections
For Each oFooter In oSection.Footers
If oFooter.Exists Then
Set oRng = oFooter.Range
oRng.Text = oRng.Text & _
sDate & vbTab & sPath & vbTab
oRng.Collapse wdCollapseEnd
oRng.Fields.Add oRng, wdFieldPage, _
preserveformatting:=False
Set oRng = oFooter.Range.Paragraphs.Last.Range
oRng.Style = "Footer"
oRng.Font.Size = 10
End If
Next oFooter
Next oSection
End With
http://www.gmayor.com/installing_macro.htm
For existing documents you could use a standard batch process as below. If
there is an existing footer, the new footer content would have to be added
after the existing footer eg by adding a new paragraph in the line
oRng.Text = oRng.Text & _
thus
oRng.Text = oRng.Text & vbCr & _
Sub BatchProcess()
Dim strFileName As String
Dim strPath As String
Dim oRng As Range
Dim oSection As Section
Dim oFooter As HeaderFooter
Dim sPath As String
Dim sDate As String
Dim oDoc As Document
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , _
"List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" _
Then strPath = strPath + "\"
End With
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(strPath) - 2)
End If
strFileName = Dir$(strPath & "*.doc")
While Len(strFileName) <> 0
Set oDoc = Documents.Open(strPath & strFileName)
'
'Do what you want with oDoc i.e.
'
sDate = Format(Date, "d MMM yyyy")
sPath = .FullName
For Each oSection In .Sections
For Each oFooter In oSection.Footers
If oFooter.Exists Then
Set oRng = oFooter.Range
oRng.Text = oRng.Text & _
sDate & vbTab & sPath & vbTab
oRng.Collapse wdCollapseEnd
oRng.Fields.Add oRng, wdFieldPage, _
preserveformatting:=False
Set oRng = oFooter.Range.Paragraphs.Last.Range
oRng.Style = "Footer"
oRng.Font.Size = 10
End If
Next oFooter
Next oSection
'
oDoc.Close SaveChanges:=wdSaveChanges
strFileName = Dir$()
Wend
End Sub
--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP
My web site
www.gmayor.com
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
