Hi All, I am new to the whole VBA scene and even newer to the forum scene. Please let me know if i am doing anything the wrong way.
I have come across the following code and managed to make some amendments to get it working.
In my testing i have noticed that the searching is omitting the headers and footers and i am not savvy enough to get it working (i think i am in over my head!).
I have over 6000 documents to search through and create a database of where one of 100 words or phrases is listed.
The script gives me exactly what i need however i just need to get it to include the header and footer of each document.
I am running Windows 7 with Office 2010.
If anyone could help me modify the code to include the headers and footers i would be very grateful!
The code i am currently using is below. Let me know if any further info is required..
Many thanks!
Branko.


Sub Main()

Const TARGET_FOLDER_PATH As String = "C:\TEMP\"

Dim fso As FileSystemObject
Dim oTargetFolder As Folder
Dim f As File

Dim appWD As Word.Application
Dim docSource As Word.Document
Dim oSearchRange As Word.Range

Dim rngPartnumber As Range
Dim Rw As Long, Paras As Long, Chk As Long


Set fso = New FileSystemObject
Set oTargetFolder = fso.GetFolder(TARGET_FOLDER_PATH)

Set appWD = New Word.Application
For Each rngPartnumber In Range("partnumbers")
Rw = rngPartnumber.Row
For Each f In oTargetFolder.Files
If UCase(Right(f.Name, 4)) = "DOCX" Then
Set docSource = appWD.Documents.Open(TARGET_FOLDER_PATH & f.Name)
Set oSearchRange = docSource.Content
With oSearchRange.Find
.ClearFormatting
.MatchWholeWord = True
.Text = rngPartnumber.Text
Do
If .Execute Then


docSource.Range(docSource.Paragraphs(1).Range.Star t, _
oSearchRange.End).Select
Paras = appWD.ActiveWindow.Selection.Paragraphs.Count
Cells(Rw, 256).End(xlToLeft).Offset(0, 1).Value = f.Name & " *Page: " & _
appWD.ActiveWindow.Selection.Information(wdActiveE ndPageNumber) _
& " *Para: " & Paras
End If
If Paras = Chk Then Exit Do
Chk = Paras
Loop
End With
docSource.Close False
End If
Next f
Next rngPartnumber
appWD.Quit False
End Sub