Search for a string in folders & subfolders, and pull its information in the same sheet

Question

Daily, I need to check serial numbers to see whether it is invoiced. We have a system that generates the invoices and exports in the C:\Serial_Numbers location path, and the invoice number is always fixed to column A side to its serial number in column B.

I tried to google a VBA code to help me and tried this, which is doing a great job, as shown in the first picture: call-tab-and-then-enter-keys-in-an-excel-vba-module and https://www.get-digital-help.com/search-all-workbooks-in-a-folder-and-sub-folders/

The main problem in this VBA is that it needs a manually select one serial (string) and get the result in a new sheet.

Edit: I tweaked the code with my limited knowledge to have the search result on the same sheet and fixed the search directory folder (first Answer), but each time I tried to loop the code in all column A serial numbers, I ended up with many errors.

'Dimensioning public variable and declaring the data type
'A Public variable can be accessed from any module, Sub Procedure, Function, or Class within a specific workbook.
Public WS As Worksheet
 
'Name macro and parameters
Sub SearchWKBooksSubFolders(Optional Folderpath As Variant, Optional Str As Variant)
 
'Dimension variables and declare data types
Dim myfolder As String
Dim a As Single
Dim sht As Worksheet
Dim Lrow As Single
Dim Folders() As String
Dim Folder As Variant
 
'Redimension array variable
ReDim Folders(0)
 
'IsMissing returns a Boolean value indicating if an optional Variant parameter has been sent to a procedure.
'Check if FolderPath has not been sent
If IsMissing(Folderpath) Then
 
    'Add a worksheet
    Set WS = Sheets.Add
 
    'Ask for a folder to search.
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        myfolder = .SelectedItems(1) & "\"
    End With
     
    'Ask for a search string.
    Str = Application.InputBox(prompt:="Search string:", Title:="Search all workbooks in a folder", Type:=2)
     
    'Stop macro if no search string is entered.
    If Str = "" Then Exit Sub
     
    'Save "Search string:" to cell "A1".
    WS.Range("A1") = "Search string:"
 
     'Save variable Str to cell "B1".
    WS.Range("B1") = Str
 
    'Save "Path:" to cell "A2".
    WS.Range("A2") = "Path:"
 
    'Save variable myfolder to cell "B2".
    WS.Range("B2") = myfolder
 
    'Save "Folderpath" to cell "A3".
    WS.Range("A3") = "Folderpath"
 
    'Save "Workbook" to cell "B3".
    WS.Range("B3") = "Workbook"
 
    'Save "Worksheet" to cell "C3".
    WS.Range("C3") = "Worksheet"
 
    'Save "Cell Address" to cell "D3".
    WS.Range("D3") = "Cell Address"
 
    'Save "Link" to cell "E3".
    WS.Range("E3") = "Link"
     
    'Save variable myfolder to variable Folderpath
    Folderpath = myfolder
     
    'Dir returns a String representing the name of a file, directory, or folder that matches a specified pattern or file attribute, or the volume label of a drive.
    Value = Dir(myfolder, &H1F)
 
'Continue here if FolderPath has been sent
Else
 
    'Check if the two last characters in Folderpath is "//".
    If Right(Folderpath, 2) = "\\" Then
 
        'Stop macro
        Exit Sub
    End If
 
    'Dir returns a String representing the name of a file, directory, or folder that matches a specified pattern or file attribute, or the volume label of a drive.
    Value = Dir(Folderpath, &H1F)
End If
 
'Keep iterating until Value is nothing
Do Until Value = ""
 
    'Check if Value is . or ..
    If Value = "." Or Value = ".." Then
 
    'Continue here if Value is not . or ..
    Else
 
        'Check if Folderpath & Value is a folder
        If GetAttr(Folderpath & Value) = 16 Then
 
            'Add folder name to array variable Folders
            Folders(UBound(Folders)) = Value
 
            'Add another container to array variable Folders
            ReDim Preserve Folders(UBound(Folders) + 1)
         
        'Continue here if Value is not a folder
        'Check if the file ends with xls, xlsx, or xlsm
        ElseIf Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then
 
            'Enable error handling
            On Error Resume Next
 
            'Check if the workbook is password protected.
            Workbooks.Open fileName:=Folderpath & Value, Password:="zzzzzzzzzzzz"
 
            'Check if an error has occurred
            If Err.Number <> 0 Then
 
                'Write the workbook name and the phrase "Password protected."
                WS.Range("A4").Offset(a, 0).Value = Value
                WS.Range("B4").Offset(a, 0).Value = "Password protected"
 
                'Add 1 to variable 1
                a = a + 1
 
                'Disable error handling
                On Error GoTo 0
 
            'Continue here if an error has not occurred
            Else
 
                'Iterate through all worksheets in the active workbook
                For Each sht In ActiveWorkbook.Worksheets
                        'Expand all groups in a sheet
                    sht.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8
 
                        'Search for cells containing search string and save to variable c
                        Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
 
                        'Check if variable c is not empty
                        If Not c Is Nothing Then
 
                            'Save cell address to variable firstAddress
                            firstAddress = c.Address
 
                            'Do ... Loop While c is not nothing
                            Do
 
                                'Save the row of the last non-empty cell in column A
                                Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row
 
                                'Save folderpath to the first empty cell in column A in worksheet WS
                                WS.Range("A1").Offset(Lrow, 0).Value = Folderpath
 
                                'Save value to the first empty cell in column B in worksheet WS
                                WS.Range("B1").Offset(Lrow, 0).Value = Value
 
                                'Save the worksheet name to  the first empty cell in column C in worksheet WS
                                WS.Range("C1").Offset(Lrow, 0).Value = sht.Name
 
                                'Save cell address to the first empty cell in column D in worksheet WS
                                WS.Range("D1").Offset(Lrow, 0).Value = c.Address
                                'Insert hyperlink
                                WS.Hyperlinks.Add Anchor:=WS.Range("E1").Offset(Lrow, 0), Address:=Folderpath & Value, SubAddress:= _
                                "'" & sht.Name & "'" & "!" & c.Address, TextToDisplay:="Link"
 
                                'Find next cell containing search string and save to variable c
                                Set c = sht.Cells.FindNext(c)
 
                            'Continue iterate while c is not empty and the cell address is not equal to the first cell address.
                            Loop While Not c Is Nothing And c.Address <> firstAddress
                        End If
 
                'Continue with the next worksheet
                Next sht
            End If
 
            'Close workbook
            Workbooks(Value).Close False
 
            'Disable error handling
            On Error GoTo 0
        End If
    End If
    Value = Dir
Loop
 
'Go through all folder names and
For Each Folder In Folders
 
    'start another instance of macro SearchWKBooksSubFolders (recursive)
    SearchWKBooksSubFolders (Folderpath & Folder & "\")
Next Folder
 
'Resize column widths
Cells.EntireColumn.AutoFit
End Sub

The current result

Expected results