How can i adapt below code to search through subfolders? Currently only searches within the folder i select via the dialog box.

Option Compare Database

 

Option Explicit

Sub SearchFoldersForContent()


Dim oWordapp As Word.Application

Dim oWorddoc As Word.Document

 

Set oWordapp = CreateObject("Word.Application")

oWordapp.Visible = True

 

Set oWorddoc = oWordapp.Documents.Add

 

Dim oRecordDoc As Word.Document, oSourceDoc As Word.Document

Dim bProtected As Boolean, lngProtType As Long

Dim oRng As Word.Range

Dim oDialog As FileDialog

 

Dim pFilename As String, pPath As String, pFind As String

Dim arrFind() As String

Dim i As Long, j As Long

 

 

'Pick folder containing files to search

 

Set oDialog = Application.FileDialog(msoFileDialogFolderPicker)

 

 

With oDialog

  .Title = "Select Folder Containing Files to Search"

  .AllowMultiSelect = False

  .InitialView = msoFileDialogViewList

 

 

 

  If .Show <> -1 Then

    MsgBox "You did not select a folder to process.", vbInformation + vbOKOnly, "PROCESS CANCELED"

    Exit Sub

  End If

  pPath = oDialog.SelectedItems.Item(1)

End With

If Right(pPath, 1) <> "\" Then pPath = pPath + "\"

 

 

'Get user defined search term/s

Do

  pFind = InputBox("Enter the word or text you want to find." & vbCr + vbCr _

                 & "To search for multiple terms separate each term with the pipe ""|"" character " & vbCr _

                 & "(e.g., Programmer|programmer|Software Developer", "SEARCH TERMS")

  pFind = RealInput(pFind)

  If pFind = "**Input canceled by user**" Then

    Exit Sub

  End If

Loop Until pFind <> ""

'Create the search array

arrFind = Split(pFind, "|")

'Develop informational text

pFind = ""

For i = 0 To UBound(arrFind)

  If i < UBound(arrFind) Then

    pFind = pFind & arrFind(i) & " - "

  Else

   pFind = pFind & arrFind(i)

  End If

Next i

 

Set oRecordDoc = ActiveDocument

 

'Set oRecordDoc = New Word.Application

 

'Set up report header, footer, heading text

With oRecordDoc

'With .Documents.Add

'End With

 

 

 

  With .Range

    .Text = "Results for Terms:  " & pFind & vbCr + vbCr

    .Paragraphs(1).SpaceBefore = 12

    .Paragraphs(1).SpaceAfter = 18

    .Paragraphs(1).Range.Font.Bold = True

  End With

    With .Sections(1).Headers(wdHeaderFooterPrimary).Range

    .Text = "Content Search Folder: " & pPath & vbCr & _

     "Creation date: " & Format(Date, "MMMM d, yyyy")

     With .ParagraphFormat.Borders(wdBorderBottom)

       .LineStyle = wdLineStyleSingle

       .LineWidth = wdLineWidth050pt

       .Color = wdColorAutomatic

     End With

     .ParagraphFormat.Borders.DistanceFromBottom = 3

  End With

  Set oRng = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range

  With oRng

    .Text = ""

    .InsertBefore "Content Report" & vbTab + vbTab

    'Working backwards

    .Collapse wdCollapseEnd

    .Fields.Add oRng, Type:=wdFieldEmpty, Text:="NUMPAGES \* Arabic "

    .Collapse wdCollapseStart

    .Text = " of "

    .Collapse wdCollapseStart

    .Fields.Add oRng, Type:=wdFieldEmpty, Text:="PAGE \* Arabic"

    With .ParagraphFormat.Borders(wdBorderTop)

       .LineStyle = wdLineStyleSingle

       .LineWidth = wdLineWidth050pt

       .Color = wdColorAutomatic

    End With

  End With

End With

'Process the files in the selected folder

pFilename = Dir$(pPath & "*.doc?")

WordBasic.DisableAutoMacros 1

While Len(pFilename) <> 0

  'Open the document for processing

  'Dim oSourceDoc As Word.Document

  Set oSourceDoc = Documents.Open(FileName:=pPath & pFilename, Visible:=False)

  'Determine protection status and unprotect if required

  bProtected = False

  If oSourceDoc.ProtectionType <> wdNoProtection Then

    bProtected = True

    lngProtType = oSourceDoc.ProtectionType

    oSourceDoc.Unprotect

  End If

  'Search for terms

  For i = 0 To UBound(arrFind)

    Set oRng = oSourceDoc.Range

    With oRng.Find

      .Execute FindText:=arrFind(i)

      'Process finding and terminate search

      If .Found Then

        j = j + 1

        oRecordDoc.Range.InsertAfter j & ".  " & pPath & pFilename & vbCr

        Exit For

      End If

    End With

  Next i

  If bProtected Then oSourceDoc.Protect lngProtType, True

  oSourceDoc.Close SaveChanges:=Word.wdDoNotSaveChanges

  'Get next file

  pFilename = Dir$()

Wend

WordBasic.DisableAutoMacros 0

oRecordDoc.Activate

'ActiveDocument.Range.InsertAfter vbCr & "Number of files found: " & j & vbCr

oRecordDoc.Range.InsertAfter vbCr & "Number of files found: " & j & vbCr

End Sub

Function RealInput(pInput As String) As String

If StrPtr(pInput) = 0 Then

  MsgBox "This process cannot be executed unless a search string is defined.", vbInformation + vbOKOnly, "CANCELING PROCESS"

  RealInput = "**Input canceled by user**"

Else

  If pInput = "" Then

    RealInput = ""

    MsgBox "You did not provide an input.", vbInformation + vbOKOnly, "NOTHING DEFINED"

  Else

    RealInput = pInput

  End If

End If

End Function

 

Private Sub Detail_Click()

Call SearchFoldersForContent

End Sub
Archie1975Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rey Obrero (Capricorn1)Commented:
see this link from:
Microsoft Access Tips for Serious Users
Provided by Allen Browne, June 2006 — adapted from a Usenet posting by Albert Kallal.  Last updated: April 2010.

List files recursively
http://allenbrowne.com/ser-59.html
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Andrei FomitchevCommented:
This approach can start search for several initial paths.

1. Create "List of Paths" (empty) - list of full paths to search
2. Add your full initial Path (or several full initial Paths) to the List of Paths.
3. -- Cycle for Paths begins here -- Get next Path from the List of Paths.
4. -- Cycle for current Path begins here. --
5. Get next item (Folder/File) from OS for the current Path.
6. If folder - create full path adding the folder to the end of the current Path.
7. and add full path to the List of Paths.
8. Do your search for the current item.
9. -- Cycle for current Path ends here --
10. -- Cycle for Paths ends here --


Note (option): you can split internal cycle into two: one for folders and one for files.
0
Jeffrey CoachmanMIS LiasonCommented:
<code to search through subfolders? >
This is called a "recursive" search.

There are a few different techniques, ...and you will have to adapt each to fit in with your specific "Search" code there...

Here is the MS Link:
http://support.microsoft.com/kb/185601

JeffCoachman
0
Rey Obrero (Capricorn1)Commented:
post at https:#a39529944  is a valid tested solution
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.