Using Excel VBA to rename files in directory

Sub ListFiles()
Dim MyFolder As String
Dim MyFile As String
Dim j As Integer
MyFolder = "C:\DealerExam"
MyFile = Dir(MyFolder & "\*.*")
a = 0
Do While MyFile <> ""
    a = a + 1
    Cells(a, 1).Value = MyFile
    MyFile = Dir
Loop
End Sub

Sub List_Files()
Dim MyFolder As String
Dim MyFile As String
Dim a As Integer
MyFolder = "C:\DealerExam\" ' <-- Change to your folder
MyFile = Dir(MyFolder & "*.*")
a = 0
Do While MyFile <> ""
    a = a + 1
    Cells(a, 1).Value = MyFile
    MyFile = Dir
Loop
MsgBox "You may now list your new names for each file in Column 'B'." & vbCr & vbCr & _
        "All cells must have valid file name.  Run 'ReName_Files' Sub when ready."
End Sub

Sub ReName_Files()
Dim r As Integer
r = 1
Do Until IsEmpty(Cells(r, "A")) Or IsEmpty(Cells(r, "B"))
Name Cells(r, "A") As Cells(r, "B")
r = r + 1
Loop
MsgBox "All your old file names in Column 'A' have been reNamed" & vbCr & _
        "to the adjacent new name in column 'B'."
End Sub

Option Explicit

'' ***************************************************************************
'' Purpose  : List selected files from a directory
'' Written  : 26-Feb-1999 by Andy Wiggins - Byg Software Ltd
''
' Two versions of this macro are shown here.
' The first version is the modified version which will parse the directories into separate columns
' The second version is the original version.
Sub ListFiles()
    
    Dim vvRes                   ''Variant to collect result
    Dim viLoopCounter%          ''For loop counter
    Dim CRCol As Integer
    Dim i As Integer
    Dim nWS As Worksheet
    Application.ScreenUpdating = False
    On Error GoTo Endit ' this is messy. The macro will add a sheet anyway and then delete it without asking. It works though.
    Set nWS = Worksheets.Add
    nWS.Cells.Activate
    ''Set an error trap - gets around a "Cancel" situation
    
    
    ''Clear the target range, column "A"
    Cells.Columns(1).ClearContents
    
    ''Go to the top left cell
    Cells(1, 1).Select
    
    ''Show the file open box and get a result
    vvRes = Application.GetOpenFilename("The lot, *.*", MultiSelect:=True)
    
    ''Loop for each result in the "fileToOpen" result ..
    For viLoopCounter = LBound(vvRes) To UBound(vvRes)
        
        '' ..  and input to a cell
        Cells(viLoopCounter, 1) = vvRes(viLoopCounter)
        
    Next
    
    
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, other:=True, OtherChar _
    :="\", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
    1)), TrailingMinusNumbers:=True
    Cells.Select
    Selection.Columns.AutoFit
    Do While Range("A1").Value = ""
        Columns(1).EntireColumn.Delete
    Loop
    Range("A1").Select
    CRCol = Selection.CurrentRegion.Columns.Count
    For i = 1 To CRCol - 2
        
        Columns(1).EntireColumn.Delete
        
    Next i
    Range("A1").EntireRow.Insert
    Range("A1").Select
    With Selection
        .Value = "Folder"
        .Font.FontStyle = "Bold"
    End With
    Range("B1").Select
    With Selection
        .Value = "Filename"
        .Font.FontStyle = "Bold"
    End With
    On Error Resume Next
    nWS.Name = Range("A2").Value
    GoTo Finish ' the macro has run with no errors
Endit:     ' perhaps someone cancelled half-way, but a sheet has been added anyway. The section deletes that sheet.
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
Finish:
End Sub
Sub FileNametoExcel()
    
    Dim fnam As Variant
    ' fnam is an array of files returned from GetOpenFileName
    ' note that fnam is of type boolean if no array is returned.
    ' That is, if the user clicks on cancel in the file open dialog box, fnam is set to FALSE
    
    Dim b As Integer 'counter for filname array
    Dim b1 As Integer 'counter for finding \ in filename
    Dim c As Integer 'extention marker
    
    ' format header
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Path and Filenames that had been selected to Rename"
    Range("A1").Select
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
    End With
    Columns("A:A").EntireColumn.AutoFit
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Input New Filenames Below"
    Range("B1").Select
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
    End With
    Columns("B:B").EntireColumn.AutoFit
    
    ' first open a blank sheet and go to top left  ActiveWorkbook.Worksheets.Add
    
    fnam = Application.GetOpenFilename("all files (*.*), *.*", 1, _
    "Select Files to Fill Range", "Get Data", True)
    
    If TypeName(fnam) = "Boolean" And Not (IsArray(fnam)) Then Exit Sub
    
    'if user hits cancel, then end
    
    For b = 1 To UBound(fnam)
        ' print out the filename (with path) into first column of new sheet
        ActiveSheet.Cells(b + 1, 1) = fnam(b)
    Next
    
    
End Sub


Sub RenameFile()
    Dim z As String
    Dim s As String
    Dim V As Integer
    Dim TotalRow As Integer
    
    TotalRow = ActiveSheet.UsedRange.Rows.Count
    
    For V = 1 To TotalRow
        
        ' Get value of each row in columns 1 start at row 2
        z = Cells(V + 1, 1).Value
        ' Get value of each row in columns 2 start at row 2
        s = Cells(V + 1, 2).Value
        
        Dim sOldPathName As String
        sOldPathName = z
        On Error Resume Next
        Name sOldPathName As s
        
    Next V
    
    MsgBox "Congratulations! You have successfully renamed all the files"
    
End Sub