Excel VBA: rename files in a folder

Hello experts,

I have the following procedure part:
Dim strFileName As String
'TODO: Specify path and file spec
Dim strFolder As String: strFolder = "C:\temp\"
Dim strFileSpec As String: strFileSpec = strFolder & "*.*"
strFileName = Dir(strFileSpec)
Do While Len(strFileName) > 0
    'TODO: replace Debug.Print by the process you want to do on the file
    'Dim strFilePath As String: strFilePath = strFolder & strFileName
    Debug.Print strFileName
    strFileName = Dir

Open in new window

I would like to take as a reference to add a full procedure in personal.xlsb to add datestamp at the end of the various files located in a reported folder (drill down subfodlers is not needed).
The idea is to have the following:
1-Display inputbox: "Select Range in which is reported reference folder"
2-Rename the various files located in the reported by adding the following string at the end of the file name: Left(flName, Len(flName) - 4) & "_" & Format$(Date, "yyyymmdd") _
& Format(Now, "hhmmss") &

Error checking:
-If reported reference folder doesn't exist exit sub and display input box "Reference folder doesn't exist"
-Exit sub if user click cancel in the first input box

If you have questions, please contact me.
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You may give this a try...
Sub RenameFiles()
Dim fso As Object
Dim srcFolder As Object
Dim aFile As Object
Dim strDateTimeStamp As String, srcFolderPath As String
Dim NewFileName As String, OldFileName As String

Set fso = CreateObject("Scripting.FileSystemObject")

On Error Resume Next
srcFolderPath = Application.InputBox("Select cell with Source Folder Path.", Type:=8).Value
On Error GoTo 0
If srcFolderPath = "" Then
    MsgBox "You didn't select the cell with folder path.", vbExclamation, "You Cancelled The Process!"
    Exit Sub
End If
If Right(srcFolderPath, 1) <> "\" Then srcFolderPath = srcFolderPath & "\"

If Not fso.FolderExists(srcFolderPath) Then
    MsgBox "The Folder " & srcFolderPath & " doesn't exists. Please check the folder path.", vbExclamation, "Folder Not Found!"
    Exit Sub
End If

strDateTimeStamp = Format(Now, "yyyymmdd-hhmmss")

Set srcFolder = fso.GetFolder(srcFolderPath)
For Each aFile In srcFolder.Files
    NewFileName = Split(aFile.Name, ".")(0) & "-" & strDateTimeStamp & "." & Split(aFile.Name, ".")(1)
    Name aFile.Path As srcFolderPath & NewFileName
Next aFile
MsgBox "All files in the folder " & srcFolderPath & " were renamed successfully.", vbInformation
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LD16Author Commented:
Thank you very much!!! Tested and it works!!!
Thank you again for your help!!!
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome! Glad it worked as desired.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.