Hi All,

I joined today at VBA Express. I am very optimistic for the solution from here.

I have a word doc which i want to open and find specific text in headers, and return all page numbers where that text is found or extract all those found pages in a separate word doc and save that as PDF.

Below is the VBA code which work well to find the text in the body of the word doc but no luck in find the text in headers.

Sub OpenWordDoc_and_GetNumber_and_save_pdf()
Dim wordapp As Word.Application
Dim findRange As Excel.Range
Dim findCell As Excel.Range
Dim rngFound As Word.Range
Dim saving_path As String


Set wordapp = CreateObject("word.Application")
wordapp.Visible = True
wordapp.Activate
wordapp.Documents.Open "A:\CITISERVICE\Attachments\Mibor\2021\Mar\22\D-Sql_MIBOR-CDT-ADVICE-O.docx" 'filename.docx"
saving_path = "A:\CITISERVICE\Attachments\Mibor\2021\Mar\22"

Set rngFound = wordapp.ActiveDocument.Range

With rngFound.Find
.Text = "Citibank"
.Execute
End With
If rngFound.Find.Found Then
page_num = rngFound.Information(wdActiveEndPageNumber)

wordapp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
saving_path & "" & "Test" & ".pdf", ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
wdExportFromTo, From:=page_num, To:=page_num, Item:=wdExportDocumentContent, _
IncludeDocProps:=False, KeepIRM:=False, CreateBookmarks:= _
wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=False, UseISO19005_1:=False

Else
MsgBox ("Text Not Found")
Exit Sub
End If



'Next findCell
wordapp.Quit


Set rngFound = Nothing
Set findCell = Nothing
Set findRange = Nothing
Set wordapp = Nothing

End Sub