Quote Originally Posted by Kalil View Post
ex1:
1- first step inputbox I write just number as in B2=25,700
2-second step inputbox I write word "DON" then the new file name
in A2=INVOICE 25,700 DONE
3- third step rename file in folders and subfoders for selected folder.
Sub test()
    Dim myDir$, s$, suf$, myList(), e, x
    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*", 0, myList())
        If IsArray(x) Then
            For Each e In x
                If Not e Like "* " & suf & ".xls*" Then
                    If Not IsFileOpen(e) Then
                        Name e As Application.Replace(e, InStrRev(e, "."), 0, " " & suf & ".")
                    Else
                        MsgBox e & String(2, vbLf) & " Is Currently in USE.", vbCritical
                    End If
                End If
            Next
        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$, n&, myList)
    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
            n = n + 1
            ReDim Preserve myList(1 To n)
            myList(n) = myDir & myFile.Name
        End If
    Next
    For Each myFolder In fso.GetFolder(myDir).SubFolders
        SearchFiles = SearchFiles(myFolder.Path & "\", myFileName, n, myList)
    Next
    If n Then
        SearchFiles = myList
    Else
        SearchFiles = CVErr(2024)
    End If
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