Excel VBA code to updated Pagenumber in MS Word footer table

Question

Hi I am using Excel VBA code to updated Word document footer table information from excel. Its work fine only problem. I am unable to update page number in word. Kindly refer the below code I am using also below image is footer table I have in word.

use of this code. This code will help me to update some information from excel to MS word footer table . work perfect but page number i need your help to make dynamic.

    Sub Update_Informe_word_2003()
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdRng As Word.Range
    Dim j As Integer
    Dim datos(0 To 1, 0 To 30) As String '(columna,fila)
    Dim ruta As String
    Dim rngFooter As Word.Range
    Dim tbl As Word.Table
    Dim rngCell As Word.Range
    Dim FileName As String
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    
    
    For i = 2 To Application.WorksheetFunction.CountA(Range("A:A"))
    
    On Error GoTo nx:
    
    
    
    If Range("C" & i).Value = "Form (FORM)" Then
    logo = Range("s2").Value
    ruta = Range("s4").Value & "\Form\Word\" & Range("B" & i).Value & ".doc"
    
    FileName = VBA.FileSystem.Dir(ruta)
    If FileName = VBA.Constants.vbNullString Then GoTo nx
    
    Set wdDoc = wdApp.Documents.Open(ruta)
 

    Set rngFooter = wdDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range
    
    rngFooter.Delete
    
    With rngFooter
    
        Set tbl = rngFooter.Tables.Add(rngFooter, 1, 3)
'        tbl.Select
        With tbl.Borders
        .OutsideLineStyle = wdLineStyleSingle
        End With
        
        
        Set rngCell = tbl.Cell(1, 3).Range
        rngCell.Text = "Doc #: " & Range("e" & i).Value & Chr(10) & "Rev. #: " & Range("H" & i).Value
        rngCell.Font.Size = 7
        rngCell.Font.Name = "Arial"
        rngCell.Paragraphs.Alignment = wdAlignParagraphRight
    
        
        Set rngCell = tbl.Cell(1, 1).Range
        rngCell.Text = "Uncontrolled When Printed" & Chr(10) & "Page 1 of 3" 
        rngCell.Font.Size = 7
        rngCell.Font.Name = "Arial"
        Set rngCell = tbl.Cell(1, 2).Range
        rngCell.Text = "VECTRUS COMPANY PROPRIETARY" & Chr(10) & "If Client Proprietary, Leave this Blank"
        rngCell.Font.Size = 7
        rngCell.Font.Name = "Arial"
        rngCell.Font.Bold = True

    End With
    
    'Set rngheader = wdDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range
    
    'rngheader.Delete
    
    'Set tbl = rngheader.Tables.Add(rngheader, 1, 3)
    'Set rngCell = tbl.Cell(1, 1).Range
    'With rngCell
    '.InlineShapes.AddPicture FileName:=logo, LinkToFile:=False, SaveWithDocument:=True
    'End With

    Dim FindWord As String
    Dim result As String

rngFooter.Find.Execute FindText:="Doc #:", Forward:=True
If rngFooter.Find.Found = True Then rngFooter.Bold = True
    
Set rngFooter = wdDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range
    
    
rngFooter.Find.Execute FindText:="Rev. #: ", Forward:=True
If rngFooter.Find.Found = True Then rngFooter.Bold = True

Set rngFooter = wdDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range

rngFooter.Find.Execute FindText:="Uncontrolled When Printed", Forward:=True
If rngFooter.Find.Found = True Then rngFooter.Bold = True

    Range("M" & i).Value = "Updated"

    wdDoc.Save
    wdDoc.Close
        End If
        
nx:
    Next
 Call Update_Informe_Excel_2003
 MsgBox ("Files updated")
End Sub

Sample image click here

Looking for your help

Answer 1

Since you print a string "Page 1 of 3" to the footer, the page number will naturally not be updated.

The current page number and total page number are stored in document fields, which you can insert with the following code:

Fields.Add oRange, wdFieldEmpty, "PAGE  \* Arabic", True
Fields.Add oRange, wdFieldEmpty, "NUMPAGES  ", True

---

In your case, replace

Set rngCell = tbl.Cell(1, 1).Range
rngCell.Text = "Uncontrolled When Printed" & Chr(10) & "Page 1 of 3" 

with

Set rngCell = tbl.Cell(1, 1).Range
rngCell.Text = "Uncontrolled When Printed" & Chr(10)

rngCell.Collapse 0
wdDoc.Fields.Add rngCell, wdFieldEmpty, "PAGE  \* Arabic", True
rngCell.InsertAfter " of "
rngCell.Collapse 0
wdDoc.Fields.Add rngCell, wdFieldEmpty, "NUMPAGES  ", True

---

To update fields, use Ctrl+A and Shift+F9 or use the following VBA:

Dim oStory
    
For Each oStory In wdDoc.StoryRanges
    oStory.Fields.Update
Next oStory