¿Cómo buscar información celular en varios libros de trabajo: actualizar?

Question

Tengo varios archivos de Excel enormes, cada uno con muchas hojas. Tengo que buscar manualmente en cada uno de ellos una cadena específica y verificar si existe en alguna parte.

He encontrado el siguiente códigoaquíy hasta ahora funciona.

Sub SearchFolders()
Dim fso As Object
Dim fld As Object
Dim strSearch As String
Dim strPath As String
Dim strFile As String
Dim wOut As Worksheet
Dim wbk As Workbook
Dim wks As Worksheet
Dim lRow As Long
Dim rFound As Range
Dim strFirstAddress As String


On Error GoTo ErrHandler
Application.ScreenUpdating = False


'Change as desired
strPath = "c:\MyFolder"
strSearch = "Specific text"

Set wOut = Worksheets.Add
lRow = 1
With wOut
    .Cells(lRow, 1) = "Workbook"
    .Cells(lRow, 2) = "Worksheet"
    .Cells(lRow, 3) = "Cell"
    .Cells(lRow, 4) = "Text in Cell"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(strPath)

    strFile = Dir(strPath & "\*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open _
          (Filename:=strPath & "\" & strFile, _
          UpdateLinks:=0, _
          ReadOnly:=True, _
          AddToMRU:=False)

        For Each wks In wbk.Worksheets
            Set rFound = wks.UsedRange.Find(strSearch)
            If Not rFound Is Nothing Then
                strFirstAddress = rFound.Address
            End If
            Do
                If rFound Is Nothing Then
                     lRow = lRow + 1
                    .Cells(lRow, 1) = wbk.Name
                    .Cells(lRow, 2) = wks.Name
                    .Cells(lRow, 3) = rFound.Address
                    .Cells(lRow, 4) = rFound.Value
Else
Exit Do

                End If
                Set rFound = wks.Cells.FindNext(After:=rFound)
            Loop While strFirstAddress <> rFound.Address
        Next

            wbk.Close (False)
            strFile = Dir
        Loop
        .Columns("A:D").EntireColumn.AutoFit
    End With
    MsgBox "Done"

ExitHandler:
    Set wOut = Nothing
    Set wks = Nothing
    Set wbk = Nothing
    Set fld = Nothing
    Set fso = Nothing
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Pero para buscar una cadena, cada vez tengo que abrir el código y cambiar la ruta y la palabra de búsqueda:

strPath = "c:\MyFolder"            
strSearch = "Specific text"

En lugar de abrir el código y cambiar la ruta cada vez, me gustaría tener de alguna manera un campo de búsqueda o algo como esto en la imagen adjunta. ¿Es posible?

¿O por ejemplo dos celdas en la hoja con los resultados, donde puedo poner la ruta y la palabra de búsqueda, sin abrir el código?

Answer 1

strPath = ActiveSheet.Range("A1").value 
strSearch = ActiveSheet.Range("B1").value

Para crear los botones, agregue controles de formulario usando la cinta del desarrollador.