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

本体はさまざまなGoogle検索からつなぎ合わされましたが、継続的に0の値を返します(他のシートのセルに値があるにもかかわらず)。

Application.Filesearch2003 年以降のバージョンの Excel では機能しないという記事をどこかで読みましたが、これが問題の原因でしょうか?

4

1 に答える 1