Iterate through spreadsheets in a folder and collect a value from each

问题

I'm trying to write code that on Commandbutton2_Click searches through the folder that the file is in, takes a value from the same cell in each file and adds these together.

I have this:

Private Sub CommandButton2_Click()

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim strFolderPath As String
Dim strToolNumber As String
Dim RingCount As Integer

RingCount = 0
strToolNumber = CStr(Sheets("Sheet1").Range("B9").Value)
strFolderPath = "T:\Engineering\Tooling\Tooling Control Engineering\Press Tool Inspection Records\" & strToolNumber & "\"

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
    Set wbCodeBook = ThisWorkbook
        With Application.FileSearch
            .NewSearch
            'Change path to suit
            .LookIn = strFolderPath
            .FileType = msoFileTypeExcelWorkbooks
                If .Execute > 0 Then 'Workbooks in folder
                    For lCount = 1 To .FoundFiles.Count 'Loop through all
                        'Open Workbook x and Set a Workbook variable to it
                        Set wbResults = Workbooks.Open(FileName:=.FoundFiles(lCount), UpdateLinks:=0)

                        'DO YOUR CODE HERE
                        RingCount = Val(RingCount) + ActiveWorkbook.Sheets("Sheet1").Range("F11").Value

                        wbResults.Close SaveChanges:=False
                    Next lCount
                End If
        End With
On Error GoTo 0

ActiveSheet.Unprotect Password:=""
ActiveWorkbook.Sheets("Sheet1").Range("F13").Value = (RingCount + ActiveWorkbook.Sheets("Sheet1").Range("F11").Value)
ActiveSheet.Protect Password:=""

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

whose main body was pieced together from different google searches - but it continually returns a value of 0 (despite the cells in the other sheets having values).

I read somewhere that Application.Filesearch does not work for versions of Excel later than 2003, could this be the source of the problem?

回答1:

Its possible to pull that value youre interested in without opening each workbook. Its much more efficient and reliable.
This code iterates through all files in the path variable and pulls values without opening the Excel files. It then prints the values starting at F20. You can then make another wrapper function to sum them up and delete or whatever you want. Hope this helps

Private Sub CommandButton2_Click()

    Dim tool As String
    tool = CStr(Sheets("Sheet1").range("B9").Value)
    Dim path As String
    path = "T:\Engineering\Tooling\Tooling Control Engineering\Press Tool Inspection Records\" & strToolNumber & "\"

    Dim fname
    fname = Dir(CStr(path)) ' gets the filename of each file in each folder
    Do While fname <> ""
        If fname <> ThisWorkbook.Name Then
            PullValue path, fname ' add values
        End If
        fname = Dir ' get next filename
    Loop
End Sub

Private Sub PullValue(path As String, ByVal fname As String)
    With range("F" & (range("F" & Rows.Count).End(xlUp).Row + 1))
        .Formula = "='" & path & "[" & fname & "]Sheet1'!F11"
        .Value = .Value
    End With
End Sub

来源：https://stackoverflow.com/questions/17722576/iterate-through-spreadsheets-in-a-folder-and-collect-a-value-from-each