• 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

    Hui...

  • 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

jacksontom

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 <<<

Code:
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
   ActiveSheet.UsedRange.Clear
   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:
Back
Top