lyphtesttest excel search 検索

Dim thisBook As Workbook
Dim result As String

Sub Sample()
    Set thisBook = ThisWorkbook
    Call FileSearch(Range("b2").value, Range("b4").value)
    Sheets("result").Activate
End Sub

Sub FileSearch(Path As String, keyWord As String)
    Dim fso As Object, Folder As Variant, File As Variant
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each Folder In fso.GetFolder(Path).SubFolders
        Call FileSearch(Folder.Path, keyWord)
    Next Folder
    For Each File In fso.GetFolder(Path).Files
        If Right(File.Path, 3) = "xls" Or Right(File.Path, 4) = "xlsx" Then
            Dim strBookName As String
            Workbooks.Open File.Path
            strBookName = ActiveWorkbook.Name
            Dim s As Worksheet
            Dim i As Integer
            i = 1
            For Each s In ActiveWorkbook.Sheets
                Call search1(File.Path, strBookName, s, keyWord)
            Next s
            Workbooks(strBookName).Close SaveChanges:=False
        End If
    Next File
End Sub

Sub search1(filePath As String, shortName As String, sheet As Worksheet, keyWord As String)

    Dim rngSerch As Range
    Set cellTmp = sheet.Cells
    Dim adr As String
    Set rngSerch = cellTmp.Find(keyWord)
    If rngSerch Is Nothing Then
        Exit Sub
    Else
        adr = rngSerch.address
        Call sheetInsert(filePath, shortName, sheet.Name, keyWord, rngSerch.address, rngSerch.value)
    End If
    
    Do
        Set rngSerch = cellTmp.FindNext(after:=rngSerch)
        If rngSerch.address = adr Then
            Exit Do
        Else
            Call sheetInsert(filePath, shortName, sheet.Name, keyWord, rngSerch.address, rngSerch.value)
        End If
    Loop
End Sub

Sub sheetInsert(filePath As String, shortName As String, sheetName As String, keyWord As String, address As String, value As String)
    Set sheetTmp = thisBook.Sheets("result")
    thisBook.Activate
    For i = 3 To sheetTmp.Range("A10000").End(xlUp).Row + 1
        If sheetTmp.Range("A" & i).value = "" Then
            sheetTmp.Range("A" & i).value = filePath
            sheetTmp.Range("B" & i).value = shortName
            sheetTmp.Range("C" & i).value = sheetName
            sheetTmp.Range("D" & i).value = keyWord
            sheetTmp.Range("E" & i).value = address
            sheetTmp.Range("F" & i).value = value
            Exit For
        End If
    Next
End Sub