vba search for pdf in folder and subfolders

[MM91]

Hi I want to be able to have the user input a part number and be able to open the .pdf. However the file location name varies due to old folder naming so I want to search a folder and subfolders for the part. I have a code but it only opens the pdf if the file location is correct. The files will be in X:\Projects\[Serial Number] then it needs to search the subfolders and open. I am stuck thanks for the help!


Dim PartNumberEntry As String
Dim PDFFilePath As String
Dim SerialNumberCode As String

PartNumberEntry = UserPartNumberInput.Text




Function OpenAnyFile(strPath As String)
Set objShell = CreateObject("Shell.Application")

If FileThere(strPath) Then
objShell.Open (strPath)
Else
MsgBox ("File Not Found")
End If

End Function

Function FileThere(FileName As String) As Boolean
If (Dir(FileName) = "") Then
FileThere = False
Else
FileThere = True
End If
End Function

Private Sub CommandButton1_Click()

With CommandButton1
.SpecialEffect = 0
.BackColor = &HC0FFC0
End With



SerialNumberCode = Left(PartNumberEntry, 4)


'Open PDF


PDFFilePath = "X:\Projects\" & SerialNumberCode
Call OpenAnyFile(PDFFilePath)



SerialNumberCode = Left(PartNumberEntry, 4)

End sub




'Open PDF


PDFFilePath = "X:\Projects\" & SerialNumberCode
Call OpenAnyFile(PDFFilePath)

 

[DanteAmor]

PartNumberEntry = UserPartNumberInput.Text

I assume you have a textbox in a userform.

With the following code, you must capture a part number in the textbox.
- Press a commandbutton.
- Choose the initial folder where you want to start the search.
If the search in all subfolders finds a pdf file with the serial number, then the macro opens the file.

Put all the code inside your userform

Option Explicit

Dim xfolders As New Collection

Private Sub CommandButton1_Click()
  Dim arch As Variant, xfold As Variant
  Dim sPath As String
  
  If UserPartNumberInput.Value = "" Then
    MsgBox "Enter part number"
    UserPartNumberInput.SetFocus
    Exit Sub
  End If
  
  With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    With .FileDialog(msoFileDialogFolderPicker)
      .Title = "Select the initial folder"
      If .Show <> -1 Then Exit Sub
      sPath = .SelectedItems(1) & "\"
    End With
  End With
  
  xfolders.Add sPath
  Call AddSubDir(sPath)
  
  For Each xfold In xfolders
    arch = Dir(xfold & "\" & Left(UserPartNumberInput.Value, 4) & "*.pdf")
    Do While arch <> ""
      ActiveWorkbook.FollowHyperlink xfold & "\" & arch
      Exit Do
      arch = Dir()
    Loop
  Next
End Sub
'
Sub AddSubDir(lPath As Variant)
  Dim SubDir As New Collection, DirFile As Variant, sd As Variant
  If Right(lPath, 1) <> "\" Then lPath = lPath & "\"
  DirFile = Dir(lPath & "*", vbDirectory)
  Do While DirFile <> ""
    If DirFile <> "." And DirFile <> ".." Then
      If ((GetAttr(lPath & DirFile) And vbDirectory) = 16) Then
        SubDir.Add lPath & DirFile
      End If
    End If
    DirFile = Dir
  Loop
  For Each sd In SubDir
    xfolders.Add sd
    Call AddSubDir(sd)
  Next
End Sub