Question

我正在尝试编写Commandbutton2_Click搜索文件所在文件夹的代码，从每个文件中的相同单元格中获取值并将它们一起添加。

我有这个：

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

其主体通过不同的谷歌搜索拼凑在一起 - 但它不断返回值0（尽管其他工作表中的单元格具有值）。

我在某处读到Application.Filesearch对于2003年以后的Excel版本不起作用，这可能是问题的根源吗？

Answer 1

可以在不打开每个工作簿的情况下获取您感兴趣的值。它更加高效和可靠。
此代码遍历 path 变量中的所有文件，并在不打开Excel文件的情况下提取值。然后打印从F20开始的值。然后，您可以创建另一个包装函数来对它们进行总结和删除，或者您想要的任何内容。希望这有帮助

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

迭代文件夹中的电子表格并从每个文件夹中收集值

1 个答案: