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