test

[soudutta2007-cyber]

Sub CleanLastPageFooter_KeepPageNumberOnly()
Dim wdApp As Object
Dim wdDoc As Object
Dim footerRng As Object
Dim lastPageNum As Long
Dim footerText As String
Dim startPos As Long, str As Variant
Dim searchStrings As Variant
Dim pageFooterRng As Object

' Word constants
Const wdStatisticPages As Long = 2
Const wdSeekMainDocument As Long = 0
Const wdSeekCurrentPageFooter As Long = 10
Const wdGoToPage As Long = 1

On Error Resume Next
' Get or create Word instance
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
End If
On Error GoTo 0
    
Set wdDoc = wdApp.ActiveDocument
wdDoc.Repaginate
lastPageNum = wdDoc.ComputeStatistics(wdStatisticPages)

' Move to last page footer explicitly
wdApp.Selection.Goto What:=wdGoToPage, Which:=1, Count:=lastPageNum
wdApp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Set footerRng = wdApp.Selection.HeaderFooter.Range

' Clone footer text (only from last page)
footerText = footerRng.Text

' --- Validate footer contains "Page X of Y" ---
If InStr(1, footerText, "Page", vbTextCompare) > 0 Then     'And InStr(footerText, "of", vbTextCompare) > 0
    searchStrings = Array("Please initial:", "Company", "Employee")
    
    ' Delete everything below the first matching string
    For Each str In searchStrings
        startPos = InStr(1, footerText, str, vbTextCompare)
        If startPos > 0 Then
            'footerText = Left(footerText, startPos - 1)
            footerText = Replace(footerText, str, "")
            'Exit For
        End If
    Next str
    
    ' Clean up and restore footer only on this page
    footerText = Trim(footerText)
    
    footerRng.Text = footerText
End If

' Return view to document
wdApp.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub