【Excel】フォルダ内のエクセルファイルのオブジェクトに対して検索を行う

Dir関数を用いるため、ネットワーク上の長いファイルパスには未対応です。

Sub Test()

    ' 画面チラつきを防止する。
    Application.ScreenUpdating = False

    ' フォルダパスとファイル名を宣言する。
    Dim strFilePath As String
    Dim strFileNmae As String
         
    ' テキストボックスかセル入力でフォルダを指定させる。
    strFilePath = "C:\Users\test\Desktop\テストディレクトリ"
    
    ' 末尾が\ではない場合、\を追加する。(未実装)
    strFilePath = strFilePath & "\"
    
    ' 指定フォルダ内のファイル名を取得する。
    strFileName = Dir(strFilePath, vbNormal)

    ' 結果シートを変数に設定する。
    Dim resultBookSheet As Worksheet
    Set resultBookSheet = Worksheets("sheet1")
   
    ' 結果シートの行数を宣言する。
    Dim longGyo As Long
    longGyo = 1

    ' 指定フォルダ内のファイルがなくなるまで繰り返す。
    Do While strFileName <> ""

        Dim result As Range
        Dim firstAddress As String

        ' ファイルを開く。
        With Workbooks.Open(Filename:=strFilePath & strFileName)

            ' ファイル内のシート数を取得する。
            Dim sheetCnt As Long
            sheetCnt = .Worksheets.Count

            ' 1シート目からnシート目まで繰り返す。
            Dim i As Long
            For i = 1 To sheetCnt

                Dim shp As Shape
                ' シートからオブジェクトがなくなるまで繰り返す。
                For Each shp In .Worksheets(i).Shapes

                    ' オブジェクトにテキストを書き込める場合
                    ' shp.TextFrameはテキストが書き込めないオブジェクトでエラーが発生してしまう。
                    ' shp.TextFrame2はOffice 2007以降で利用可能だが、
                    ' テキストが書き込めないオブジェクトでもエラーが発生しない。
                    If shp.TextFrame2.HasText = True Then

                        ' 検索文字列がオブジェクト内に存在する場合
                        If InStr(shp.TextFrame2.TextRange.Text, "Excute") > 0 Then
                            resultBookSheet.Cells(longGyo, 1).Value = strFilePath & strFileName
                            resultBookSheet.Cells(longGyo, 2).Value = .Worksheets(i).Name
                            resultBookSheet.Cells(longGyo, 3).Value = "セル(" & shp.TopLeftCell.Address & ") - オブジェクト"
                            resultBookSheet.Cells(longGyo, 4).Value = shp.TextFrame2.TextRange.Text
                            longGyo = longGyo + 1
                        End If
                    End If
                Next
            Next i
            
            ' 保存せずファイルを閉じる。
            .Close SaveChanges:=False
        End With

        ' 次のファイルを取得する。
        strFileName = Dir()
    Loop
        
    ' 画面チラつき防止を解除する。
    Application.ScreenUpdating = True
    
End Sub