Search keyword in folder and return if match found.

[pawanhsharma]

Hi, below is the scenario I am trying to get an answer.
I have a folder with thousands of pdf file. The file name is not standard. I need to search the correct for for my records. As of now this need to be done manually however I am sure there must be some way.

For ex if I put a keyword bga63948, I only need which is the correct file so I open and work on it.

I have found below code but looks like it is for workbooks and not pdf.

Option Explicit
Sub BatchProcessFolderAndSubFolders()
Dim vFolders As Variant
Dim lngIndex As Long
Dim strPath As String
Dim strfilename As String
vFolders = fcnGetSubfolders("d:\My Documents\Word\Word Documents\Word Tips\Macros")
For lngIndex = LBound(vFolders) To UBound(vFolders)
strPath = vFolders(lngIndex)
On Error GoTo Err_NoFiles
strfilename = Dir$(strPath & "*.do*")
While Len(strfilename) <> 0
'You could open the file here and pass it to a function to do something to it.
Debug.Print strfilename
strfilename = Dir$()
Wend
ReEntry:
Next
lbl_Exit:
Exit Sub
Err_NoFiles:
Resume ReEntry
End Sub
Public Function fcnGetSubfolders(ByVal FolderToRead As String) As Variant
Dim AllSubFolders(0) As Variant
On Error Resume Next
System.Cursor = wdCursorWait
If (Right$(FolderToRead, 1) <> "\") Then FolderToRead = FolderToRead & "\"
'Set the path as the first entry in the array and pass the array to the main function.
AllSubFolders(0) = FolderToRead
fcnGetSubfolders = fcnGetAllSubfolders(AllSubFolders)
System.Cursor = wdCursorNormal
'StatusBar = ""
On Error GoTo 0
lbl_Exit:
Exit Function
End Function
Private Function fcnGetAllSubfolders(ByVal AllSubFoldersArray As Variant) As Variant
'This is a recursive function, that is it calls itself as required.
Dim lngCounter As Long
Dim strCurrentFolderName As String
Dim strSubFolderName As String
Dim arrSubFolderList() As String
On Error Resume Next
strCurrentFolderName = CStr(AllSubFoldersArray(UBound(AllSubFoldersArray)))
ReDim arrSubFolderList(0)
strSubFolderName = Dir$(strCurrentFolderName, vbDirectory)
Do While Len(strSubFolderName) <> 0
If strSubFolderName <> "." _
And strSubFolderName <> ".." _
And InStr(1, strSubFolderName, "?") = 0 Then
If (GetAttr(strCurrentFolderName & strSubFolderName) And vbDirectory) = vbDirectory Then
ReDim Preserve arrSubFolderList(UBound(arrSubFolderList) + 1)
arrSubFolderList(UBound(arrSubFolderList)) = strSubFolderName
'StatusBar = "Reading Subfolders... (" & strCurrentFolderName & ": -> " & strSubFolderName & ")"
End If
End If
strSubFolderName = Dir$()
Loop
'Sort the list with the subfolders.
If UBound(arrSubFolderList) > 0 Then WordBasic.SortArray arrSubFolderList()
For lngCounter = 1 To UBound(arrSubFolderList)
'Up the size of the AllSubFoldersArray array by one
ReDim Preserve AllSubFoldersArray(UBound(AllSubFoldersArray) + 1)
AllSubFoldersArray(UBound(AllSubFoldersArray)) = _
strCurrentFolderName & arrSubFolderList(lngCounter) & "\"
AllSubFoldersArray = fcnGetAllSubfolders(AllSubFoldersArray)
Next lngCounter
fcnGetAllSubfolders = AllSubFoldersArray
On Error GoTo 0
End Function

Any help would be greatly appreciated. I only want to find the file. The folder will remain same.

Thanks in advance.

 

[pawanhsharma]

Just want to clarify, I am not searching the keyword in file name, although itself in the file. Thanks