0

我正在尝试编写代码，在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 版本，这可能是问题的根源吗？

4

1 回答 1

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
于 2013-07-18T13:44:35.397 回答