Sub FindInSubfoldersFileOpen()
   Dim StrFile As String, objFSO, destRow As Long
   Dim mainFolder, mySubFolder
   mFolder = Range("B2").Value ' initial folder
   fname = Range("B3").Value ' file name
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set mainFolder = objFSO.GetFolder(mFolder)
   StrFile = Dir(mFolder & "\" & fname)
   If StrFile <> "" Then
      Workbooks.Open mFolder & "\" & StrFile
   Else
     For Each mySubFolder In mainFolder.SubFolders
       StrFile = Dir(mySubFolder & "\" & fname)
       If StrFile <> "" Then
          Workbooks.Open mySubFolder & "\" & StrFile
          Exit For
       End If
     Next
   End If
End Sub