Adapt VBA to import from subfolders

[excelboy92]

I've been trying to build a spreadsheet to import data from specific cells in workbooks to a master workbook. So far, I've been able to get this VBA working when it's just a set of workbooks within a single folder. However, we typically store these workbooks in a series of subfolders formatted C:\Users\user\Documents\Data\Month\Date\OrderType . All the workbooks are in the final OrderType folders. Can anyone help me adapt this macro to import data from subfolders?

This is the code I'm using to import data from one folder during my tests so far:

Public Sub Copy_Values_From_Workbooks()

Dim matchWorkbooks As String
Dim destSheet As Worksheet, r As Long
Dim folderPath As String
Dim wbFileName As String
Dim fromWorkbook As Workbook

'Folder path and wildcard workbook files to import cells from

matchWorkbooks = "C:\Users\users\Desktop\Test Workbooks\*.xlsm"   'CHANGE THIS

'Define destination sheet

Set destSheet = ActiveWorkbook.Worksheets("Sheet1")  'CHANGE THIS

r = 0

Application.ScreenUpdating = False

folderPath = Left(matchWorkbooks, InStrRev(matchWorkbooks, "\"))
wbFileName = Dir(matchWorkbooks)
While wbFileName <> vbNullString
Set fromWorkbook = Workbooks.Open(folderPath & wbFileName)
With fromWorkbook.Worksheets("Cover Sheet")
destSheet.Range("E3").Offset(r).Value = .Range("E24").Value
destSheet.Range("F3").Offset(r).Value = .Range("E25").Value
destSheet.Range("C3").Offset(r).Value = .Range("C6").Value
destSheet.Range("G3").Offset(r).Value = .Range("N24").Value
destSheet.Range("H3").Offset(r).Value = .Range("N25").Value
destSheet.Range("D3").Offset(r).Value = .Range("C10").Value
End With
With fromWorkbook.Worksheets("Order Data")
destSheet.Range("I3").Offset(r).Value = .Range("G29").Value
destSheet.Range("J3").Offset(r).Value = .Range("G31").Value
r = r + 1
End With
fromWorkbook.Close savechanges:=False
DoEvents
wbFileName = Dir
Wend

Application.ScreenUpdating = True

MsgBox "Finished"

End Sub

I attempted to use multiple pieces of VBA I found online in combination with this to pull the data from subfolders, but was ultimately unable to get it to work. Thanks in advance for any advice/code, I appreciate it!

 

[John_w]

You need a recursive FileSystemObject procedure which looks in the subfolders. See if you can adapt this code:

Read data from the same worksheet name in multiple workbooks located in multiple directories/subdirectories

Kindly looking for assistance. I need to loop thru multiple folders/subfolders in drive "C:\MyExcelFiles\ROM\Test\" ( ~400 files that were copied from SharePoint) to read data from a common worksheet name in each workbook. In each workbook that I find with "*ROM*.xlsm", I need to look in the...

www.mrexcel.com

That code imports from all the matching files in the folder tree, so you might need to adapt it to only import files when the folder scan reaches the OrderType subfolder.

 

[excelboy92]

You need a recursive FileSystemObject procedure which looks in the subfolders. See if you can adapt this code:

Read data from the same worksheet name in multiple workbooks located in multiple directories/subdirectories

Kindly looking for assistance. I need to loop thru multiple folders/subfolders in drive "C:\MyExcelFiles\ROM\Test\" ( ~400 files that were copied from SharePoint) to read data from a common worksheet name in each workbook. In each workbook that I find with "*ROM*.xlsm", I need to look in the...

www.mrexcel.com

That code imports from all the matching files in the folder tree, so you might need to adapt it to only import files when the folder scan reaches the OrderType subfolder.

Okay, so I attempted to adapt the code and have been running into a little bit of difficulty. I'm getting a compile error near the end, for argument not optional. I commented where the error pops up on the code below.

Option Explicit



Public Sub Import_Data_From_Workbooks()



Application.ScreenUpdating = False

Application.DisplayAlerts = False



With ThisWorkbook.Worksheets("Data")

Import_Data_From_Workbooks_In_Folder "C:\Users\users\Desktop\Test Workbooks\*.xls", .Range("B1").Value, .Range("B2").Value, .Range("A5") 

End With



Application.ScreenUpdating = True

Application.DisplayAlerts = True



MsgBox "Done"



End Sub





Private Function Import_Data_From_Workbooks_In_Folder(folderPath As String, matchFiles As String, fromSheetName As String, destCell As Range, destSheet As Worksheet) As Long



Static FSO As Object

Dim Folder As Object, Subfolder As Object, File As Object

Dim dataWb As Workbook

Dim r As Long

Dim n As Long



If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")



'Process files in this folder



n = 0

r = 0

Set destSheet = ActiveWorkbook.Worksheets("Data")

Set Folder = FSO.GetFolder(folderPath)

For Each File In Folder.Files

If LCase(File.Name) Like LCase(matchFiles) Then

'Copy cell values from data workbook

Set dataWb = Workbooks.Open(File.Path)

With dataWb.Worksheets("Cover Sheet")

destSheet.Range("E3").Offset(r).Value = .Range("E24").Value

destSheet.Range("F3").Offset(r).Value = .Range("E25").Value

destSheet.Range("C3").Offset(r).Value = .Range("C6").Value

destSheet.Range("G3").Offset(r).Value = .Range("N24").Value

destSheet.Range("H3").Offset(r).Value = .Range("N25").Value

destSheet.Range("D3").Offset(r).Value = .Range("C10").Value

End With

With dataWb.Worksheets("Order Data")

destSheet.Range("I3").Offset(r).Value = .Range("G29").Value

destSheet.Range("J3").Offset(r).Value = .Range("G30").Value

dataWb.Close False

r = r + 1

n = n + 1

End With

End If

Next



'Process files in subfolders



For Each Subfolder In Folder.SubFolders

n = n + Import_Data_From_Workbooks_In_Folder(Subfolder.Path, matchFiles, fromSheetName, destCell.Offset(n)) 'Error here: Argument not optional

Next



Import_Data_From_Workbooks_In_Folder = n





End Function

I don't particularly understand what ".Range("B1").Value, .Range("B2").Value, .Range("A5")" is supposed to do, or the way the other poster was importing data:
"destCell.Offset(n, 0).Resize(25, 2).Value = Application.Transpose(.Range("D11:D12").Value)
destCell.Offset(n, 2).Resize(25, 2).Value = .Range("C18:D42").Value"

Thanks again!

 

[John_w]

I don't particularly understand what ".Range("B1").Value, .Range("B2").Value, .Range("A5")" is supposed to do

They are the 2nd, 3rd and 4th arguments to the Import_Data_From_Workbooks_In_Folder function call:

    With ThisWorkbook.Worksheets("Summary")
        Import_Data_From_Workbooks_In_Folder "C:\MyExcelFiles\ROM\Test\", .Range("B1").Value, .Range("B2").Value, .Range("A5")
    End With

which correspond to the matchFiles, fromSheetName and destCell arguments:

Private Function Import_Data_From_Workbooks_In_Folder(folderPath As String, matchFiles As String, fromSheetName As String, destCell As Range) As Long

or the way the other poster was importing data:
"destCell.Offset(n, 0).Resize(25, 2).Value = Application.Transpose(.Range("D11:D12").Value)
destCell.Offset(n, 2).Resize(25, 2).Value = .Range("C18:D42").Value"

The first line reads the 2 values from D11:D12, transposes them and puts them in a 25 rows x 2 columns 'grid' (the 2 values are repeated in 25 rows across 2 columns) starting at destCell offset by 'n' rows and zero columns (the destCell argument is A5), i.e. the number of rows done so far. n increases by 25 each time. Look at the OP's sheet A5:B29 cells.

The second line reads the values from C18:D42 (25 rows x 2 columns) and puts them in a 25 x 2 columns 'grid' starting at destCell offset by 'n' rows and 2 columns, which is column C because the destCell argument is A5. Look at the OP's sheet C5:D29 cells.

 

[excelboy92]

That actually explains a lot, thanks! I was able to get everything working last night and it worked perfectly. Really appreciate the help thanks a lot!