Sub test()
    Dim myDir$, s$, suf$, x, n&
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1)
    End With
    If myDir = "" Then Exit Sub
    Do
        s = InputBox("Enter amount")
        If s = "" Then Exit Do
        suf = InputBox("Enter word")
        If suf = "" Then Exit Do
        x = SearchFiles(myDir & "\", "*" & s & ".xls*")
        If x <> "" Then
            n = n + IIf(n, 1, 2)
            Cells(n, 2) = CreateObject("Scripting.FileSystemObject").GetBaseName(x)
            Cells(n, 3) = x
            If Not IsFileOpen(x) Then
                Name x As Application.Replace(x, InStrRev(x, "."), 0, " " & suf)
                 Cells(n, 1) = Cells(n, 2) & " " & suf
            Else
                Cells(n, 4) = "Currently in USE " & Format(Now, "yyyy/mm/dd hh:mm:ss")
            End If
        Else
            MsgBox "Not found"
        End If
        If MsgBox("Do you want to continue?", vbQuestion + vbYesNo) <> vbYes Then Exit Do
    Loop
End Sub


Function SearchFiles$(myDir$, myFileName$)
    Dim fso As Object, myFolder As Object, myFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each myFile In fso.GetFolder(myDir).Files
        If (Not myFile.Name Like "~$*") * (myFile.Name <> ThisWorkbook.Name) _
        * (myFile.Name Like myFileName) Then
            SearchFiles$ = myDir & myFile.Name
            Exit Function
        End If
    Next
    For Each myFolder In fso.GetFolder(myDir).SubFolders
        SearchFiles = SearchFiles(myFolder.Path & "\", myFileName)
    Next
End Function


Function IsFileOpen(ByVal fName$) As Boolean
    Dim ff&, errNum&
    On Error Resume Next
    ff = FreeFile
    Open fName For Input Lock Read As #ff
    Close ff
    errNum = Err
    On Error GoTo 0
    IsFileOpen = (errNum <> 0)
End Function