Get the data from excel files in sub directories

Question

I am new to VBA and to programming in general. This is my first post on this board. I\'ve been working on this for a while modifying code I\'ve found on the internet and I h

Answer 1

The creation of the array that you are doing has to be inside the ProcessFiles function which is taken from here. Once the array is made, rest of your original code ALMOST remains as it is. I had to make changes to GetInfoFromClosedFile function as well so when you copy, copy the complete code given below as it is and do not change anything.

Option Explicit

Dim wbList() As String
Dim wbCount As Long

Sub ReadDataFromAllWorkbooksInFolder()
    Dim FolderName As String
    Dim cValue As Variant, bValue As Variant, aValue As Variant
    Dim dValue As Variant, eValue As Variant, fValue As Variant
    Dim i As Long, r As Long

    FolderName = ThisWorkbook.Path & "\Receiving Temp"

    ProcessFiles FolderName, "*.xls"

    If wbCount = 0 Then Exit Sub

    r = 1

    For i = 1 To UBound(wbList)

        '~~> wbList(i) will give you something like
        '   C:\Receiving Temp\aaa.xls
        '   C:\Receiving Temp\FOLDER1\aaa.xls
        Debug.Print wbList(i)

        r = r + 1
        cValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "c9")
        bValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "o61")
        aValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "ae11")
        dValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "v9")
        eValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "af3")
        fValue = GetInfoFromClosedFile(wbList(i), "Non Compliance", "a1")

        Sheets("Sheet1").Cells(r, 1).Value = cValue
        Sheets("Sheet1").Cells(r, 2).Value = bValue
        Sheets("Sheet1").Cells(r, 3).Value = aValue
        Sheets("Sheet1").Cells(r, 4).Value = dValue
        Sheets("Sheet1").Cells(r, 6).Value = eValue
        Sheets("Sheet1").Cells(r, 5).Value = fValue
     Next i
End Sub

'~~> This function was taken from
'~~> http://www.vbaexpress.com/kb/getarticle.php?kb_id=245
Sub ProcessFiles(strFolder As String, strFilePattern As String)
    Dim strFileName As String, strFolders() As String
    Dim i As Long, iFolderCount As Long

    '~~> Collect child folders
    strFileName = Dir$(strFolder & "\", vbDirectory)
    Do Until strFileName = ""
        If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then
            If Left$(strFileName, 1) <> "." Then
                ReDim Preserve strFolders(iFolderCount)
                strFolders(iFolderCount) = strFolder & "\" & strFileName
                iFolderCount = iFolderCount + 1
            End If
        End If
        strFileName = Dir$()
    Loop

    '~~> process files in current folder
    strFileName = Dir$(strFolder & "\" & strFilePattern)
    Do Until strFileName = ""
        wbCount = wbCount + 1
        ReDim Preserve wbList(1 To wbCount)
        wbList(wbCount) = strFolder & "\" & strFileName
        strFileName = Dir$()
    Loop

    '~~> Look through child folders
    For i = 0 To iFolderCount - 1
        ProcessFiles strFolders(i), strFilePattern
    Next i
End Sub

Private Function GetInfoFromClosedFile(ByVal wbFile As String, _
wsName As String, cellRef As String) As Variant
    Dim arg As String, wbPath As String, wbName As String

    GetInfoFromClosedFile = ""

    wbName = FunctionGetFileName(wbFile)
    wbPath = Replace(wbFile, "\" & wbName, "")

    arg = "'" & wbPath & "\[" & wbName & "]" & _
          wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)

    On Error Resume Next
    GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function

'~~> Function to get file name from the full path
'~~> Taken from http://www.ozgrid.com/VBA/GetExcelFileNameFromPath.htm
Function FunctionGetFileName(FullPath As String)
    Dim StrFind As String
    Dim i As Long

    Do Until Left(StrFind, 1) = "\"
        i = i + 1
        StrFind = Right(FullPath, i)
        If i = Len(FullPath) Then Exit Do
    Loop
    FunctionGetFileName = Right(StrFind, Len(StrFind) - 1)
End Function