
Originally Posted by
Kalil
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