Rename files in the end name based on use inputbox

[Kalil]

Hello,
I have code to populate files names in column B, what I want new procedure to combine with original code . so the new procedure should use dialog inputbox first write specific file name after click ok show new inputbox to write word in inputbox after that should rename file name in column A and rename file name within folder or subfolder is existed in selected folder.
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.


ex2:
1- first step inputbox I write just number as in B3=25,240
2-second step inputbox I write word "CURRENT" then the new file name in A3=INVOICE 25,240 CURRENT
the words should add in the end of numbers.
3- third step rename file in folders and subfoders for selected folder.
important: could be there are files contains the same name but within subfolders so should rename first and when run again then should rename next (don't rename the same files names at once)
thanks

[arnelgp]

1 and 2 step is somewhat clear.
how about step 3? do you need to rename filename in column B with filename in Column A on same row?

[Kalil]

do you need to rename filename in column B with filename in Column A on same row?
rename in column A and keep old name in column B.

[arnelgp]

here try this.

[Kalil]

Thanks for code , but I would fix repeating same names files within subfolders as I said

important: could be there are files contains the same name but within subfolders so should rename first and when run again then should rename next (don't rename the same files names at once)

I should rename or change file have already named for the same files names should be one by one every time run the form , but the code will rename at once for all of same files names and I don't want it.
also if there is possible to show new file name in column A for adjacent cell for column B instead off add new rows.

[Aussiebear]

As I currently understand the OP's request to be this:

Take a filename (or part of a filename) from a cell in column B.
Prompt the user with an input box to enter a word.
Combine the filename from column B with the entered word to create a new filename, and write this new filename in the corresponding cell in column A.
Rename the actual file in the folder (and subfolders) to the new filename.
Handle cases where multiple files with the same name exist in different subfolders, ensuring they are renamed one by one across multiple executions.

If the above is correct then perhaps this might suffice


Option Explicit


' Function to check if a file exists
Private Function FileExists(ByVal fName As String) As Boolean
FileExists = (Dir(fName) <> "")
End Function


' Function to recursively search for files in a folder and its subfolders
Private Function FindFile(ByVal startFolder As String, ByVal fileNameToFind As String, ByRef foundFilePath As String) As Boolean
Dim fso As Object, folder As Object, subFolder As Object, file As Object
Dim found As Boolean
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(startFolder)
' Check files in the current folder
For Each file In folder.Files
If file.Name = fileNameToFind Then
foundFilePath = file.Path
FindFile = True
Exit Function ' Exit the function if found
End If
Next file
' If not found, recursively search subfolders
If Not found Then
For Each subFolder In folder.SubFolders
found = FindFile(subFolder.Path, fileNameToFind, foundFilePath)
If found Then
Exit Function ' Exit the function if found in a subfolder
End If
Next subFolder
End If
End Function


Sub RenameFiles()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim fileNamePart As String
Dim newWord As String
Dim newFileName As String
Dim fso As Object
Dim filePath As String
Dim originalFileName As String
Dim fileExtension As String
Dim tempFileName As String
Dim fileWasRenamed As Boolean
Dim startFolder As String ' Added variable to store the starting folder path
' Set the worksheet (change "Sheet1" to your actual sheet name)
Set ws = ThisWorkbook.Sheets("Sheet1")
' Get the last row in column B
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
' Create FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
' Get the starting folder from the user. Use a constant for testing.
' startFolder = Application.InputBox("Enter the full path of the folder to search:", "Enter Folder Path", , , , , , 8192) 'Type 8192 is for folder selection
startFolder = "C:\Your\Path\Here" ' <--- Replace this with your actual folder path for testing. Remove the hardcoded path and uncomment the InputBox line above for user input.
If startFolder = "False" Then ' Check if the user cancelled the inputbox
MsgBox "Operation cancelled by user.", vbOKOnly, "Cancelled"
Exit Sub
End If
If Not fso.FolderExists(startFolder) Then
MsgBox "Invalid folder path. Please enter a valid folder path.", vbCritical, "Error"
Exit Sub
End If
' Loop through the rows in column B
For i = 2 To lastRow
fileNamePart = Trim(ws.Cells(i, "B").Value)
If fileNamePart <> "" Then
' Get the new word from the user
newWord = Trim(InputBox("Enter the word to add to the filename for " & fileNamePart & ":", "Enter Word"))
If newWord = "" Then
MsgBox "No word entered. Skipping file rename for " & fileNamePart & ".", vbOKOnly, "Skipped"
GoTo NextIteration ' Use a label to jump to the next iteration
End If
' Construct the new filename (add the word to the end of the number)
newFileName = "INVOICE " & fileNamePart & " " & newWord
ws.Cells(i, "A").Value = newFileName ' Update the cell in column A
' Find the file and rename it
originalFileName = fileNamePart 'The original file name is what is in column B
filePath = "" 'Reset
If FindFile(startFolder, originalFileName, filePath) Then ' Find the file.
fileExtension = fso.GetExtensionName(filePath)
If fileExtension <> "" Then
originalFileName = originalFileName & "." & fileExtension ' Add the extension back.
End If
' Construct the *full* new file name with extension.
newFileName = "INVOICE " & fileNamePart & " " & newWord & "." & fileExtension
' Check if the file exists before attempting to rename.
If FileExists(filePath) Then
fileWasRenamed = False
On Error Resume Next 'prevent errors if rename fails
Name filePath As fso.GetParentFolderName(filePath) & "\" & newFileName
On Error GoTo 0
If FileExists(fso.GetParentFolderName(filePath) & "\" & newFileName) Then
fileWasRenamed = True
End If
If fileWasRenamed Then
MsgBox "File '" & originalFileName & "' renamed to '" & newFileName & "'.", vbInformation, "File Renamed"
Else
MsgBox "Failed to rename file '" & originalFileName & "'. It may already be renamed, or the file may be in use.", vbCritical, "Rename Failed"
End If
Else
MsgBox "File '" & originalFileName & "' not found.", vbExclamation, "File Not Found"
End If
Else
MsgBox "File '" & originalFileName & "' not found in the specified folder or subfolders.", vbExclamation, "File Not Found"
End If
End If
NextIteration:
Next i
MsgBox "File renaming process completed.", vbInformation, "Done"
' Clean up
Set fso = Nothing
Set ws = Nothing
End Sub

[arnelgp]

this will only rename 1 file.
if you have multiple file with same filename on subfolder, you need to run again the Userform.

[jindon]

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

[Kalil]

Aussiebear


If the above is correct then perhaps this might suffice
this is exactly what I look for, but unfortunately your code doesn't work well
for some reason will rename files and ignore others and will skip files in main folder and rename in subfolder .
strangely when try adding words will show me message not found in the specified folder or subfolders!!:doh:
despite the original cod in OP will brings files in column B,C so why show me this message?!:(

[Kalil]

this will only rename 1 file.

but this is will start from subfolder and ignore main folder arnelgp . I suppose starting from main folder one file by one until and move next subfolder and so on .and why start from lastrow when add new file ,why not put on adjacent cell for old name in column B?!

[Kalil]

Great work ,jindon!
but I need to fix repeating for the same files names.
I would start when renaming from main folder and move next subfolder one file by one and so on
not renaming at once for same files names within folders and subfolders as your code does it.
also I would show new names files in column A for adjacent cells in column B after renaming within folders and subfolders.

[arnelgp]

but this is will start from subfolder and ignore main folder arnelgp . I suppose starting from main folder one file by one until and move next subfolder and so on .and why start from lastrow when add new file ,why not put on adjacent cell for old name in column B?!
then select the main folder.

[jindon]

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

[Kalil]

then select the main folder.
this is what I really did it .:wot

[Kalil]

thanks jindon for your effort.
but this is not I want !
if I have in column B:C like this
86,000.00 C:\Users\pc\KLL\main\86,000.00.xlsm
INVOICE 87,000.00 C:\Users\pc\KLL\main\DTA\87,000.00.xlsm
so in column A should be when write done
then
will be
86,000.00 done. 86,000.00 C:\Users\pc\KLL\main\86,000.00.xlsm
and when write current then will be
86,000.00 done. 86,000.00 C:\Users\pc\KLL\main\86,000.00.xlsm
INVOICE 87,000.00 current 87,000.00 C:\Users\pc\KLL\main\DTA\87,000.00.xlsm
also when I would change files have already written
ex:
86,000.00 done. 86,000.00 C:\Users\pc\KLL\main\86,000.00.xlsm
when write 86,000.00 done and I would change to current then should change from done to current like this
86,000.00 current. 86,000.00 C:\Users\pc\KLL\main\86,000.00.xlsm
also I would when rename should select cell in column B or C if I write then will rename file based on selected cell if I don't write anything then will skip and move next cell to select and so on .
last thing I don't want dot (.) when I write word.

[jindon]

I don't understand what you are talking about, so wait for someone else.

[Kalil]

the problem will be for same files names .:banghead:

I admit the case is really complicated .
ok guys
here are some pictures
when I have many same files names then should move and active cell by select when click input box without write amounts
example :
if I write amount 12,000.00 as in B2 and write DONE will rename for B2 in folders or subfolders as in PIC 1,2 ,3 , but the question is how avoid B2
and I would rename file B5 as pic 4,5 also I would change amount contains done word to current word as in pic 6,7 should change in A5 from done to current .
and as I mentioned many times every new name file should be in adjacent in column b like picture 8,9

[Kalil]

here rest of pictures 4,5

[Kalil]

here is pic 6,7

[Kalil]

pictur 8,9

[Aussiebear]

I'm with jindon on this one. Whilst I understand that english may not be your first language, trying to decifer what exactly you are after is rather confusing. So i'm going to wait on the sidelines and watch.

[Kalil]

Aussiebear

Did you read post#9
did you test your code?!
the only thing I added after name specific file for instance 12,000.00 DONE then I would rename again by delete DONE and I would add CURRENT
so inputbox first 12,000.00 DONE second write CURRENT so will rename 12,000.00 CURRENT as I mentioned in post#19
but your code doesn't work !

[Aussiebear]

As I said, I 'm somewhat confused with what you actually want, so I will sit on the sideline.

[Kalil]

I 'm somewhat confused with what you actually want
not sure why you're confused!:doh:
your code rename in just column A without rename any file in directory !:think: