VBA Excel: rename files

Luis Diaz
Luis Diaz used Ask the Experts™
on
Hello experts,

I have the following procedure which allows me to rename files.

Sub Rename_Files()
'Updateby20141124
Dim xDir As String
Dim xFile As String
Dim xRow As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
xDir = .SelectedItems(1)
xFile = Dir(xDir & Application.PathSeparator & "*")
Do Until xFile = ""
xRow = 0
On Error Resume Next
xRow = Application.Match(xFile, Range("A:A"), 0)
If xRow > 0 Then
Name xDir & Application.PathSeparator & xFile As _
xDir & Application.PathSeparator & Cells(xRow, "B").Value
End If
xFile = Dir
Loop
End If
End With
End Sub

Open in new window


I would like to add a msgbox vbyes & vbyes at the beginning of the procedure with the following message:
"Before running this procedure, please check that old_files_names are reported in column A and new_files_names are reported in column B. If so, please click on Yes else click on No and run List Files procedure in order to get files to rename."

If you have questions, please contact me.
Regards,
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:
Try it like this...
Sub Rename_Files()
'Updateby20141124
Dim xDir As String
Dim xFile As String
Dim xRow As Long
Dim Ans As VbMsgBoxResult

Ans = MsgBox("Before running this procedure, please check that old_files_names are reported in column A and new_files_names are reported in column B." & _
vbNewLine & "If so, please click on Yes else click on No and run List Files procedure in order to get files to rename.", vbQuestion + vbYesNo, "Confirm Please!")
If Ans = vbNo Then Exit Sub

With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show = -1 Then
        xDir = .SelectedItems(1)
        xFile = Dir(xDir & Application.PathSeparator & "*")
        Do Until xFile = ""
            xRow = 0
            On Error Resume Next
            xRow = Application.Match(xFile, Range("A:A"), 0)
            If xRow > 0 Then
                Name xDir & Application.PathSeparator & xFile As _
                xDir & Application.PathSeparator & Cells(xRow, "B").Value
            End If
            xFile = Dir
        Loop
    End If
End With
End Sub

Open in new window

Luis DiazIT consultant

Author

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

Commented:
You're welcome! Glad it worked as desired.
Thanks for the feedback.

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