Insert page number in footer using VBA

I am trying to start a new document and setup the header and footer from MS Access, but can't seem to get it to work.  i have found different sample on how to do it inside Word, but when I try to port it, it always  fails, beyond which the methods I have found are all so different, so I'm wondering which approach is proper.

 

    Dim wordapp         As Object
    Dim Doc             As Object
    Dim rng
    Const wdHeaderFooterPrimary = 1
    Const wdAlignParagraphCenter = 1
    Const wdFieldEmpty = -1

    Set wordapp = CreateObject("Word.application")

    wordapp.Visible = True
    Set Doc = wordapp.Documents.Add()
    Set rng = Doc.Sections(1).Footers(1).Range
        With rng
            .insertbefore "Page "
            .Fields.Add Range:=selection.Range, Type:=wdFieldEmpty, Text:= _
                        "PAGE ", PreserveFormatting:=True
            .insertbefore " of "
            .Fields.Add Range:=selection.Range, Type:=wdFieldEmpty, Text:= _
                        "NUMPAGES ", PreserveFormatting:=True
        End With

 

As it stands, it break at the 1st .Fields.Add.Range

 

How can I do this, I thought it would be a simple task, and several hours later, I still can't even insert a bloody page number?!

QuestionBoy

|
Answer
Answer

Option Explicit
Sub ScratchMacro()
Dim oWordApp As Object
Dim oDoc As Object
Dim oRng As Range
Dim oFooterRng1 As Range
Dim oFooterRng2 As Range

Set oWordApp = CreateObject("Word.application")
oWordApp.Visible = True
Set oDoc = oWordApp.Documents.Add()
  Set oRng = oDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range
  With oRng
    .Text = "Page PAGE of NUMPAGES Pages"
    Set oFooterRng1 = oRng.Words(2)
    Set oFooterRng2 = oRng.Words(4)
  End With
  'Insert the field code around PAGE expression
  fInsertFields oFooterRng1, "PAGE"
  'Insert the field code around the NUMPAGES expressions
  fInsertFields oFooterRng2, "NUMPAGES"
  oRng.Fields.Update
  ActiveWindow.View.ShowFieldCodes = False
lbl_Exit:
  Exit Sub
End Sub
Public Sub fInsertFields(oRng As Range, Optional strText As String)
  With oRng
    'Find the expression and add a field around it
    With .Find
      .Text = strText
      .MatchCase = True
      .MatchWholeWord = True
      While .Execute
        oRng.Fields.Add oRng, wdFieldEmpty, , False
        oRng.Collapse wdCollapseEnd
      Wend
    End With
  End With
lbl_Exit:
  Exit Sub
End Sub

Greg Maxey
***
Death smiles at us all, but all a man can do is smile back.


For more help with Word visit:
http://gregmaxey.com/word_tips.html

5 people found this reply helpful

·

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

 
 

Question Info


Last updated April 21, 2021 Views 10,628 Applies to: