Excel VBA: rename files in a folder

Luis Diaz
Luis Diaz used Ask the Experts™
on
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
Loop

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.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
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

Luis DiazIT consultant

Author

Commented:
Thank you very much!!! Tested and it works!!!
Thank you again for your help!!!
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
You're welcome! Glad it worked as desired.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial