Copy values from files in subgroup folders

Question

Im having trouble getting all files returned from my code. I have a large amount of files in subfolders of a directory that I need to copy information from certain cells, how would I get the code to return all .xlsx in the folder plus the subfolders?

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
     
matchWorkbookCs = "D:\Data\Analysis\Service\records\Templates\*.xlsx"

'Define destination sheet
      
Set destSheet = ActiveWorkbook.Worksheets("Report")

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("Dashboard")
        destSheet.Range("A2").Offset(r).Value = .Range("C5").Value
        destSheet.Range("B2").Offset(r).Value = .Range("C3").Value
        destSheet.Range("C2").Offset(r).Value = .Range("D51").Value
        destSheet.Range("D2:E2").Offset(r).Value = .Range("D56:E56").Value
        r = r + 1
    End With
    fromWorkbook.Close savechanges:=False
    DoEvents
    wbFileName = Dir
Wend

Application.ScreenUpdating = True

MsgBox "Finished"

End Sub

Does this answer your question? [Get File list from folders and subfolders Excel VBA](https://stackoverflow.com/questions/68246938/get-file-list-from-folders-and-subfolders-excel-vba) — Foxfire And Burns And Burns, Jul 05 '22 at 06:28

FaneDuru · Answer 1 · 2022-07-06T08:07:11.973

0

Please, use this function. It will return an array with all xlsx files from folder and its subfolders:

Private Function getAllFiles(strFold As String, Optional strExt As String = "*.*") As Variant
    getAllFiles = filter(Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & strFold & strExt & """ /b/s").StdOut.ReadAll, vbCrLf), "\")
End Function

You can implement it in your code in the next way:

Sub Copy_Values_From_Workbooks()
 Dim folderPath As String, destSheet As Worksheet, r As Long, i As Long
 Dim wbFileName, fromWorkbook As Workbook, arrFiles

 'Folder path:
 folderPath = "D:\Data\Analysis\Service\records\Templates\" 'the ending backslash (\) is mandatory

 'Define destination sheet
 Set destSheet = ActiveWorkbook.Worksheets("Report")

 r = 0
 arrFiles = getAllFiles(folderPath, "*.xlsx") 'place all necessary workbooks full name in an array
 
 Application.ScreenUpdating = False
      
 For Each wbFileName In arrFiles 'iterate between the wokbooks array elements:
    Set fromWorkbook = Workbooks.Open(wbFileName)
    With fromWorkbook.Worksheets("Dashboard")
        destSheet.Range("A2").Offset(r).value = .Range("C5").value
        destSheet.Range("B2").Offset(r).value = .Range("C3").value
        destSheet.Range("C2").Offset(r).value = .Range("D51").value
        destSheet.Range("D2:E2").Offset(r).value = .Range("D56:E56").value
        r = r + 1
    End With
    fromWorkbook.Close savechanges:=False
    DoEvents
 Next wbFileName

 Application.ScreenUpdating = True

 MsgBox "Finished"
End Sub

Not tested, but it should work...

Please, send some feedback after testing it.

edited Jul 06 '22 at 08:07

answered Jul 05 '22 at 07:31

FaneDuru

38,298
4
19
27

1

That's a great little function. I can't see how it uses the `boolSubfolders` parameter though? – CLR Jul 05 '22 at 08:34
@CLR You may check it simple: return its result in an array (`Dim arr`) and after calling the function try `Debug.Print Join(arr, "|"). You will see the result in `Immediate Window`... It is very fast, too. – FaneDuru Jul 05 '22 at 08:38
@Orfevre Didn't you find some time to test the above suggested solution? If tested, didn't it work as you need? – FaneDuru Jul 05 '22 at 13:54
@FaneDuru My apologies for the delay, im getting a compile error, sub or function not defined. If running the private function I get an access denied error unfortunately. – Orfevre Jul 05 '22 at 23:24
@Orfevre Strange... Do you work on MacSO? – FaneDuru Jul 06 '22 at 07:08
@FaneDuru Work on windows, im assuming its security on the work computer. – Orfevre Jul 06 '22 at 07:10
I am curious about the part of the code considered a threaten... You can try splitting the function code in its components. Firstly, please try `Dim x As Object` follow by `Set x = CreateObject("wscript.shell")` Do you receive any error? If so, it looks that the company policy does not allow using VBScript objects... If so, i think I can try adapting it using `Shell` instead, but it will not be so compact. It is not possible in standard VBA to directly read the result of `Dir` from `cmd`... – FaneDuru Jul 06 '22 at 07:18
Sorry Im not following where should I be putting the Dim x As object? – Orfevre Jul 06 '22 at 07:28
@Orfevre Sorry, I was not clear... In a separate `Sub`. I would like understanding if this ActiveX cannot be created by the code in your environment. – FaneDuru Jul 06 '22 at 07:31
@FaneDuru no error on that, it runs. – Orfevre Jul 06 '22 at 07:35
@Orfevre This is good. Now, did you use `folderPath` **exactly as in my above code**? Only the folder, ending in backslash "\"... – FaneDuru Jul 06 '22 at 07:38
@FaneDuru Yes it has the \ – Orfevre Jul 06 '22 at 07:40
@Orfevre And is it correct? What does `Debug.Print Dir(left(folderPath, Len(folderPath) - 1), vbDirectory)` return in `Immediate Window`? – FaneDuru Jul 06 '22 at 07:47
Returns the folder name – Orfevre Jul 06 '22 at 07:54
@Orfevre Then, I cannot understand what's happening... Do you have Teamviewer or AnyDesk installed and a connection can be accepted by your company security rules? – FaneDuru Jul 06 '22 at 08:00
@FaneDuru no i dont sorry, saying "getAllFiles = Filter(Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & strFold & strExt & """ /b/s").StdOut.ReadAll, vbCrLf), "\")" is the issue thanks for your help though it has been great. – Orfevre Jul 06 '22 at 08:07
@Orfevre Please, try the updated solution. I only eliminated the option to search excepting subfolders (problematic, anyhow...) and the main code calls the function without `True` as the third parameter. – FaneDuru Jul 06 '22 at 08:09

Copy values from files in subgroup folders

1 Answers1