Macro to open a workbook from an unknown file path

**paul_sykes00** · 11-28-2012, 09:22 PM

Please can someone provide me with a macro to do the following:

Find a file (say test.xls) from a unknown file path (say in a subdirectory on C:/ drive)

Thanks

**patel45** · 11-29-2012, 04:39 AM

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

**paul_sykes00** · 11-29-2012, 08:24 PM

Patel45. Still having trouble with this one.

Macro seems to stop on Set objFSO = CreateObject("Scripting.FileSystemObject")

Any suggestions why??

**paul_sykes00** · 11-30-2012, 01:24 AM

Ahhh finally got it working. Seems issue is that it can search one subdirectory deep. Is it possible to modify it to search through say 4 tiers for subdirectories? Thanks for your help.

**patel45** · 11-30-2012, 04:27 AM

Sub FindInSubfolders() ' main, call SubFoldersFind
   Dim StrFile As String, objFSO, destRow As Long, fname As String
   Dim mainFolder, mySubFolder
   mFolder = Range("B2").Value
   fname = Range("B3").Value
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set mainFolder = objFSO.GetFolder(mFolder)
   StrFile = Dir(mFolder & "\" & fname)
   If StrFile <> "" Then
      Workbooks.Open mFolder & "\" & StrFile
   Else
      SubFoldersScan OfFolder:=mainFolder, fname:=fname
   End If
End Sub
   
Sub SubFoldersScan(OfFolder As Variant, fname As String) 
    Dim SubFolder
    For Each SubFolder In OfFolder.SubFolders
       StrFile = Dir(SubFolder & "\" & fname)
       If StrFile <> "" Then
          Workbooks.Open SubFolder & "\" & StrFile
          Exit For
       End If
       SubFoldersScan OfFolder:=SubFolder, fname:=fname
    Next SubFolder
End Sub

**paul_sykes00** · 12-02-2012, 11:52 PM

Thanks very Patel45. That works great now. Is it possible to add the following step too.

Say cell B4 in the original spreadsheet (where this macro is located) is the name of a macro in the newly opened spreadsheet. I need to run this macro and then copy data (say cell B5) from the original spread sheet into the newly opened spreadsheet (say into cell A1)

Hope that makes sense. Thanks again

**patel45** · 12-03-2012, 02:42 AM

obviously not tested

Sub FindInSubfolders() ' main, call SubFoldersFind
   Dim StrFile As String, objFSO, destRow As Long, fname As String
   Dim mainFolder, mySubFolder
   mFolder = Range("B2").Value
   fname = Range("B3").Value
   macroname = Range("B4").text
   mdata = Range("B5").text   
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set mainFolder = objFSO.GetFolder(mFolder)
   StrFile = Dir(mFolder & "\" & fname)
   If StrFile <> "" Then
      Workbooks.Open mFolder & "\" & StrFile
   Else
      SubFoldersScan OfFolder:=mainFolder, fname:=fname
   End If
   Range("A1").value = mdata
   nn = ActiveWorkbook.Name
   Application.Run "'" & nn & "'!" & macroname
End Sub
   
Sub SubFoldersScan(OfFolder As Variant, fname As String) 
    Dim SubFolder
    For Each SubFolder In OfFolder.SubFolders
       StrFile = Dir(SubFolder & "\" & fname)
       If StrFile <> "" Then
          Workbooks.Open SubFolder & "\" & StrFile
          Exit For
       End If
       SubFoldersScan OfFolder:=SubFolder, fname:=fname
    Next SubFolder
End Sub