Using Excel VBA to rename files in directory

[samilynn]

is it possible to have a spreadsheet with two columns, Col A showing a list of current file names in a particular directory, and Col B the names I want these files to be renamed to. Is there some code that I can use to do this, or do I have to rename these files one by one until I get old?

Thanks,

Samantha

 

[jfarc]

Well samilynn, I can get you half the way there(so maybe you'll only be half as old???)

This will list all the files in your directory starting in cell 'A1'

(change appropriate MyFolder name of course and you can be selective on the type of files to list by changing "\*.*" to "\*.xls" or whatever)

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

I'll look into the Renaming function, but I have to logoff for now, so hopefully this will get you going in the right direction or someone else can lead you from here.

 

[jfarc]

Hey samilynn,

Don't know if you resolved your issue, but the following seems to work pretty well. I think I have some use for it myself.

It is 2 routines:

List_Files - Reads all the file names in your stated folder and lists them in column 'A'.

Then you should enter your New File Name in each adjacent cell in column 'B'. You can obviously make this a formula based upon the name in 'A', or just hand-key them in. You can delete row(s) of file names if you wish not to rename some of them. This routine assumes you are placing valid file names with proper extensions in column 'B'.

When you are ready with all the new file names in 'B', run the 'ReName_Files' routine to do the renaming.

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

 

[imskin]

i encounter run-time error '53' file not found when execute rename_files().When i click debug,it link me to

Name Cells(r,"A") As Cells(r,"B")

 

[Harry Flashman]

is it possible to have a spreadsheet with two columns, Col A showing a list of current file names in a particular directory, and Col B the names I want these files to be renamed to. Is there some code that I can use to do this, or do I have to rename these files one by one until I get old?

Thanks,

Samantha

These are the macros I use.
ListFiles

FileNametoExcel
RenameFile


The important ones are FilenameToExcel (run this one first) and RenameFile (run this one second) after filling in the column with the new file name (you will see what I mean after you run FilenameToExcel).
The macro ListFiles just lists the files on a separate worksheet and is used for preping the filenames (for example using formulas to amend the file name in some way). I usually copy my amended file names and paste into the special range that is created by the macro FilenameToExcel.

I suggest you practice using these macros with a backup folder.

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

 

[imskin]

Thanks. It save a lot of my time in doing my work

 

[Mayo77]

Dear's, I need to rename my files as below i have thousands like that:

CH1 2000 --> CH2 2000
CH2 2000 --> CH1 2000

i use above codes but below error shows up:

[/IMG]

 

[Harry Flashman]

Dear's, I need to rename my files as below i have thousands like that:

CH1 2000 --> CH2 2000
CH2 2000 --> CH1 2000

i use above codes but below error shows up:

[/IMG]

Your problem is that you are trying to swap file names around and in some case you end up with a situation where two files have the same name, which of course is not allowed.

I suggest you run the routine twice. The first run simply append another character (such as a letter or the word "temp") to start (or end) of the file name. Then run the routine again but this time naming the files as you would like them to be.

 

[Mayo77]

Dear Harry, First thank alot for fast respond, the way it works , second i need to code to copy images from folder to another folder as per their names i will put it in excel.

 

[Harry Flashman]

Dear Harry, First thank alot for fast respond, the way it works , second i need to code to copy images from folder to another folder as per their names i will put it in excel.

As that is a different task from renaming files, may I suggest you make a new thread, with a descriptive subject title. For example, Excel VBA - Copy files from one folder to another.