• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 48
  • Last Modified:

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


  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) & " - "


   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


  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$()


WordBasic.DisableAutoMacros 0


'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**"


  If pInput = "" Then

    RealInput = ""

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


    RealInput = pInput

  End If

End If

End Function


Private Sub Detail_Click()

Call SearchFoldersForContent

End Sub
  • 2
1 Solution
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
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.
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:

Rey Obrero (Capricorn1)Commented:
post at https:#a39529944  is a valid tested solution
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get 10% Off Your First Squarespace Website

Ready to showcase your work, publish content or promote your business online? With Squarespace’s award-winning templates and 24/7 customer service, getting started is simple. Head to Squarespace.com and use offer code ‘EXPERTS’ to get 10% off your first purchase.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now