Add Page Number To Footer - vba

Question

I've got a bunch of documents that I need to add page numbering in the footer.
I tried writing a macro to do this but after I run there's still no page numbers (in header or footer)
Sub AddPageNumberToFooter()
Call DeleteExistingFooters
With ActiveDocument
.PageSetup.DifferentFirstPageHeaderFooter = False
.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add
End With
End Sub
Sub DeleteExistingFooters()
Dim iSectionCnt As Integer
iSectionCnt = ActiveDocument.Sections.Count
If iSectionCnt > 0 Then
ActiveDocument.Sections(iSectionCnt).Footers(wdHeaderFooterPrimary).Range.Delete
End If
End Sub
What am I missing?

Answer 1

The following code will add Page #s to all documents lacking them in every page in the selected folder:
Sub UpdateDocumentFooters()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim wdDoc As Document, Sctn As Section, HdFt As HeaderFooter
strFolder = GetFolder: If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
If strFolder & "\" & strFile <> ThisDocument.FullName Then
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
AddToRecentFiles:=False, Visible:=False)
With wdDoc
For Each Sctn In .Sections
For Each HdFt In Sctn.Footers
With HdFt
If .Exists Then
If Sctn.Index = 1 Then
Call AddPgFld(HdFt)
ElseIf .LinkToPrevious = False Then
Call AddPgFld(HdFt)
End If
End If
End With
Next
Next
.Close SaveChanges:=True
End With
End If
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
Sub AddPgFld(HdFt As HeaderFooter)
Dim Fld As Field, bFld As Boolean
With HdFt
bFld = False
For Each Fld In .Range.Fields
If Fld.Type = wdFieldPage Then
bFld = True: Exit For
End If
Next
If bFld = False Then
With .Range.Paragraphs.Last.Range
If Len(.Text) > 2 Then .InsertAfter vbCr
End With
With .Range.Paragraphs.Last.Range
.Text = "Page "
.Fields.Add Range:=.Characters.Last, Type:=wdFieldEmpty, Text:="PAGE", PreserveFormatting:=False
.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
End If
End With
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Answer 2

As you are writing that you have a bunch of documents: Could it be that ActiveDocument isn't the correct reference.
This works for me - you can replace ActiveDocument from the test-sub with any other document:
Option Explicit
Sub testPagenumbersForActiveDocument()
dim docToTest as Word.Document
set docToTest = ActiveDocument 'replace ActiveDocument with another doc you have opened
deleteExistingPageNumbers docToTest
addPageNumberToFooter docToTest
End Sub
Sub addPageNumberToFooter(doc As Word.Document)
With doc
.PageSetup.DifferentFirstPageHeaderFooter = False
.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add
End With
End Sub
Sub deleteExistingPageNumbers(doc As Word.Document)
Dim sec As Section, pn As PageNumber
For Each sec In doc.Sections
For Each pn In sec.Footers(wdHeaderFooterPrimary).PageNumbers
pn.Delete
Next
Next
End Sub
The delete-sub only deletes PageNumbers - this is safer then your version as that will delete the whole footer-text ... which might be not what you want.