VBA Find Pattern Word file and export every two pages as .pdf

Question

I have Word file (154 pages). I need to take every 2 pages and export as .pdf (I did this), but I need also to add file name like EExxxxxxxx (patern), I set reg pattern like "(EE[0-9]{8})" it's ok in my opinion, because it find the first pattern, always EE and 8 numbers (examples below). The same pattern are on every two pages. I can't get it from this two pages, and add this value as file name, because I get only the first pattern (and script finish searching, when I go to next 2 pages inside Word file), but the same time next files (with 2 right pages) are creating. Of cource every pages have a lot of different text, but the paterns are the most important.

Word File:
Page 1:EE30000229
Page 2:EE30000229
Page 3:EE30000089
Page 4:EE30000089
...
Page 153: EE30001889
Page 154: EE30001889

Script1:

Option Explicit
Sub SaveAsSeparatePDFs()
 
Dim strDirectory As String, strTemp As String
Dim ipgStart As Integer, ipgEnd As Integer
Dim iPDFnum As Integer, i As Integer
Dim vMsg As Variant, bError As Boolean
Dim Name As String
Dim RegEx As VBScript_RegExp_55.RegExp
Set RegEx = New VBScript_RegExp_55.RegExp
Dim Matches As VBScript_RegExp_55.matchCollection
Dim Match As VBScript_RegExp_55.Match


1:
strDirectory = InputBox("Directory to save individual PDFs? " & _
    vbNewLine & "(ex: C:\Users\Public)")
If strDirectory = "" Then Exit Sub
If Dir(strDirectory, vbDirectory) = "" Then
    vMsg = MsgBox("Please enter a valid directory.", vbOKCancel, "Invalid Directory")
    If vMsg = 1 Then
        GoTo 1
    Else
        Exit Sub
    End If
End If

2:
strTemp = InputBox("Begin saving PDFs starting with page __? " & _
    vbNewLine & "(ex: 32)")
bError = bErrorF(strTemp)
If bError = True Then GoTo 2
ipgStart = CInt(strTemp)

3:
strTemp = InputBox("Save PDFs until page __?" & vbNewLine & "(ex: 37)")
bError = bErrorF(strTemp)
If bError = True Then GoTo 3
ipgEnd = CInt(strTemp)

iPDFnum = ipgStart
On Error GoTo 4:

 
For i = ipgStart To ipgEnd Step 2
    
   '-- This code creating .pdf includes every two pages. But I need add some code that give to me also
   '-- right file name with EExxxxxxxx and exchange iPDFnum that is below
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        strDirectory & "\Page_" & iPDFnum & ".pdf", ExportFormat:=wdExportFormatPDF, _
        OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
        wdExportFromTo, From:=i, to:=i + 1, Item:=wdExportDocumentContent, _
        IncludeDocProps:=False, KeepIRM:=False, CreateBookmarks:= _
        wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False
    iPDFnum = iPDFnum + 2
   
Next i
End

End
4:
vMsg = MsgBox("Unknown error encountered while creating PDFs." & vbNewLine & vbNewLine & _
    "Aborting", vbCritical, "Error Encountered")
End Sub

Private Function bErrorF(strTemp As String) As Boolean
Dim i As Integer, vMsg As Variant
bErrorF = False

If strTemp = "" Then
    End
ElseIf IsNumeric(strTemp) = True Then
    i = CInt(strTemp)
    If i > ActiveDocument.BuiltInDocumentProperties(wdPropertyPages) Or i <= 0 Then
        Call msgS(bErrorF)
    End If
Else
    Call msgS(bErrorF)
End If
End Function

Private Sub msgS(bMsg As Boolean)
Dim vMsg As Variant
    vMsg = MsgBox("Please enter a valid integer." & vbNewLine & vbNewLine & _
        "Integer must be > 0 and < total pages in the document (" & _
        ActiveDocument.BuiltInDocumentProperties(wdPropertyPages) & ")", vbOKCancel, "Invalid Integer")
    If vMsg = 1 Then
        bMsg = True
    Else
        End
    End If
End Sub

The next Sub, that can show all of the patterns (EExxxxxxxx) from Word file. I don't now how to add these two scripts so that they generate files contain 2 more pages from the Word file and their name includes the EExxxxxxxx template. I change .Global also with True, but still show only the first pattern from the list.

Script2:

 Sub Find()
 Dim RegEx As VBScript_RegExp_55.RegExp
 Set RegEx = New VBScript_RegExp_55.RegExp
 Dim Matches As VBScript_RegExp_55.matchCollection
 Dim Match As VBScript_RegExp_55.Match
    
 With RegEx
     .IgnoreCase = False
     .MultiLine = True
     .Global = False    
     .Pattern = "(EE[0-9]{8})"
 End With
 Set Matches = RegEx.Execute(ActiveDocument.Content.Text)
 For Each Match In Matches
     MsgBox (Match.Value)
 Next Match

End Sub

Anyone can help to me? It's important project to my organisation.

Answer 1

You really don't need RegEx to do this. Word's built-in Find function can be used with wildcards to match patterns. The function below will return the text matching your pattern if found on the specified page.

Function FindPattern(pageNum As Long) As String
    Dim rngFind As Range
    Set rngFind = ActiveDocument.GoTo(What:=wdGoToPage, Name:=pageNum)
    Set rngFind = rngFind.GoTo(What:=wdGoToBookmark, Name:="\Page")
    With rngFind.Find
        .ClearFormatting
        .Text = "EE[0-9]{8}"
        .MatchWildcards = True
        .Wrap = wdFindStop
        If .Execute Then FindPattern = rngFind.Text
    End With
End Function

You would use it inside your loop, for example:

For i = ipgStart To ipgEnd Step 2
    text = FindPattern(i)

EDIT: Code used for testing

Sub SaveAsSeparatePDFs()
 
    Dim strDirectory As String, strTemp As String
    Dim ipgStart As Integer, ipgEnd As Integer
    Dim iPDFnum As Integer, i As Long
    Dim vMsg As Variant, bError As Boolean
    Dim Name As String, patternText As String

1:
    strDirectory = InputBox("Directory to save individual PDFs? " & _
            vbNewLine & "(ex: C:\Users\Public)")
    If strDirectory = "" Then Exit Sub
    If Dir(strDirectory, vbDirectory) = "" Then
            vMsg = MsgBox("Please enter a valid directory.", vbOKCancel, "Invalid Directory")
            If vMsg = 1 Then
                  GoTo 1
            Else
                  Exit Sub
            End If
    End If

2:
    strTemp = InputBox("Begin saving PDFs starting with page __? " & _
            vbNewLine & "(ex: 32)")
    bError = bErrorF(strTemp)
    If bError = True Then GoTo 2
    ipgStart = CInt(strTemp)

3:
    strTemp = InputBox("Save PDFs until page __?" & vbNewLine & "(ex: 37)")
    bError = bErrorF(strTemp)
    If bError = True Then GoTo 3
    ipgEnd = CInt(strTemp)

    iPDFnum = ipgStart
    On Error GoTo 4:

 
    For i = ipgStart To ipgEnd Step 2
        patternText = FindPattern(i)
           '-- This code creating .pdf includes every two pages. But I need add some code that give to me also
           '-- right file name with EExxxxxxxx and exchange iPDFnum that is below
            ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                  strDirectory & "\Page_" & iPDFnum & ".pdf", ExportFormat:=wdExportFormatPDF, _
                  OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
                  wdExportFromTo, From:=i, to:=i + 1, Item:=wdExportDocumentContent, _
                  IncludeDocProps:=False, KeepIRM:=False, CreateBookmarks:= _
                  wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
                  BitmapMissingFonts:=False, UseISO19005_1:=False
            iPDFnum = iPDFnum + 2
   
    Next i
    End

    End
4:
    vMsg = MsgBox("Unknown error encountered while creating PDFs." & vbNewLine & vbNewLine & _
            "Aborting", vbCritical, "Error Encountered")
End Sub