Hello All,



I find this VBA program and have been trying to modify it. I'm having some issues. I'm trying to search multiple word files between two headings. But the headings in each of these word files are not Heading Style format, instead, it is Normal Style. I need the program to search each word documents and output the text/body include tables, photos, etc between the two headings.

Any thoughts on how I can do this?






Sub CP_Between_Text()

Application.ScreenUpdating = False

Dim strFolder As String, strFile As String, strDocNm As String, strTmp As String, strOut As String
Dim wdDoc As Document, Rng As Range, i As Long

Dim FindWord1, FindWord2 As String
Dim result As String
FindWord1 = "System Safety Assessment Summary"
FindWord2 = "Hardware Considerations"

strDocNm = ActiveDocument.FullName
strFolder = GetFolder: If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)

While strFile <> ""
If strFolder & "" & strFile <> strDocNm Then
Set wdDoc = Documents.Open(FileName:=strFolder & "" & strFile, AddToRecentFiles:=False, Visible:=False)
strTmp = ""
With wdDoc
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = FindWord1
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = 1
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
For i = 0 To UBound(Split(.Text, ","))
.Text = Split(.Text, ",")(i)
.Execute
If .Found = True Then strTmp = strTmp & ", " & Split(.Text, ",")(i)
Next
End With
If strTmp <> "" Then strOut = strOut & vbCr & strFile & ": " & strTmp
.Close SaveChanges:=True
End With
End If
strFile = Dir()
Wend
Set wdDoc = Nothing
ActiveDocument.Range.Text = "The following matches were made:" & strOut
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder( 0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function