• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User


  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

run this macro but the result not show


New Member
I want to use this code to traverse all folders and their subfolders in the specified folder, and find all word documents that contain the same keywords, and return the file name and its link

>>> use code - tags <<<

Option Explicit

Sub choosethemeetwordinthefolders()
   Dim arr(1 To 1000, 1 To 2), strFldPath As String, fso, str1, r%, fd, f, j%
   Set fso = CreateObject("scripting.filesystemobject")
      With Application.FileDialog(msoFileDialogFolderPicker)
   'choose the folder
       .Title = "the folder"
       If .Show Then strFldPath = .SelectedItems(1) Else Exit Sub
   End With
   str1 = Application.InputBox("input the key of word filename", "input", "", , , , , 2)
   If str1 = False Then
       MsgBox "not valid"
       Exit Sub
   End If
   r = 0
   Application.ScreenUpdating = False

   For Each fd In fso.getfolder(strFldPath).subfolders
       For Each f In fd.Files
           If InStr(f.Name, ".doc") > 0 And InStr(f.Name, str1) > 0 Then
               r = r + 1
               arr(r, 1) = f.Name
               arr(r, 2) = f
           End If
       Next f
   Next fd
   If r > 0 Then
       [a1].Resize(r, 2) = arr
       For j = 1 To r
           ActiveSheet.Hyperlinks.Add Anchor:=Cells(j, 1), Address:=arr(j, 2), TextToDisplay:=arr(j, 1)
       Next j
   End If
   Application.ScreenUpdating = True
End Sub
Last edited by a moderator: