Good Afternoon.

I have been working on a LIMS system based in excel and have nearly finish but one minor niggle.

(Note, before the suggestions come in,
No, creating a template with bookmarks and using that will not work (due to network security setting in place - they cannot/will not be change.)
No, creating the template as an embedded Object does not work either and the fidelity keeps getting lost.)

So userform is used to collect the data required, this then updates a log sheet before populating an excel sheet which is then copied and pasted into a new word document which is then automatically saved.

Titivation then takes place playing around with margins and adding standardised Header/Footer, This is where the problem arises....

I am trying to put "Page 'X' of 'Y' " into the footer in column 2 of the table as marked in the code below [RED]. However, I cannot work out how to get the vbascript to add the field code in at this point. I have tried the code detailed below which causes the function to stop and kills any further running. If I leave this [With/End With] bit out then the report is generated but without the page numbers.

Help ??

Function FnWriteToWordDoc()
 
    Set objWord = CreateObject("Word.Application")
 
    Set objDoc = objWord.Documents.Add
  
    Set objSelection = objWord.Selection
   
    objWord.Visible = False ''
   
 
    '######## Page Setup #############
  
      With objSelection.PageSetup
 
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(2.27)
        .BottomMargin = CentimetersToPoints(2.27)
        .LeftMargin = CentimetersToPoints(1.27)
        .RightMargin = CentimetersToPoints(1.27)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(0.75)
        .FooterDistance = CentimetersToPoints(0.75)
        .PageWidth = CentimetersToPoints(21)
        .PageHeight = CentimetersToPoints(29.7)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
       
    End With
   
 
   With objSelection
 
        .Paste           '> Paste the Excel Data into Word
           
        .InsertBreak Type:=wdPageBreak
       
        .Font.Size = 14
        .Font.Bold = True
        .Font.Underline = wdUnderlineSingle
        .TypeText Text:="Summary:"
        .TypeParagraph
        .Font.Size = 11
        .Font.Bold = False
        .Font.Underline = wdUnderlineNone
        .TypeText Text:="xx:"
        .TypeParagraph
        .TypeParagraph
       
        .Font.Size = 14
        .Font.Bold = True
        .Font.Underline = wdUnderlineSingle
        .TypeText Text:="Report:"
        .TypeParagraph
        .Font.Size = 11
        .Font.Bold = False
        .Font.Underline = wdUnderlineNone
        .TypeText Text:="xx:"
        .TypeParagraph
        .TypeParagraph
    End With
   
 
    Dim oTbl
   
    'HEADER<<<<<<<<<
    objDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables.Add _
    Range:=objDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range, _
    NumRows:=1, _
    NumColumns:=3
     
  Set oTbl = objDoc.Sections(1).Headers(1).Range.Tables(1)
     With oTbl.Cell(1, 1).Range
        .Font.Size = 16
        .Font.Color = 192
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
        .Text = "MATERIALS REVIEW"
    End With
   
    With oTbl.Cell(1, 2).Range
        .Font.Size = 14
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .Text = "Laboratory Report"
    End With
   
    With oTbl.Cell(1, 3).Range
        .Font.Size = 14
        .Font.Color = 192
        .ParagraphFormat.Alignment = wdAlignParagraphRight
        .Text = "Request: " & E_Req
 
    End With
   
  Set oTbl = Nothing
   
    'FOOTER  <<<<<<<<<
    objDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range.Tables.Add _
    Range:=objDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range, _
    NumRows:=1, _
    NumColumns:=3
 
  Set oTbl = objDoc.Sections(1).Footers(1).Range.Tables(1)
 
    With oTbl.Cell(1, 1).Range
        .Font.Size = 11
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
        .Text = "DO NOT COPY WITHOUT PERMISSION OF QUALITY MANAGER"
    End With
   
    With oTbl.Cell(1, 2).Range  <<This 'WITH Section' is where the issue is.
   
        .Fields.Add Range:=oTbl.Cell(1, 2).Range, _
               Type:=wdFieldEmpty, _
               Text:="NUMPAGES  \* Arabic", _
               PreserveFormatting:=True       
    End With
   
   
    With oTbl.Cell(1, 3).Range
        .Font.Size = 12
        .Font.Color = 192
        .ParagraphFormat.Alignment = wdAlignParagraphRight
        .Text = "CONFIDENTIAL"
    End With
   
  Set oTbl = Nothing
 
'## Save Script
If REPRINT = True Then
    objDoc.SaveAs (S_PATH & E_Req & "rp - " & E_DESC)
 
Else
 
    objDoc.SaveAs (S_PATH & E_Req & " - " & E_DESC)    'Save the template with data in by RQ number and description in the Reports Path
      
End If
 
MsgBox ("Your Lab request has been raised." & vbCrLf & _
        "to add any further information please open the word file  " & vbCrLf & _
        E_Req & " - " & E_DESC)
 
    objWord.Visible = True
   
 
End Function