Rename files based on excel worksheet list

**badgeradrian** · 08-10-2009, 10:55 AM

Hi All,

Really hoping you can help here.

Each month I get a load of files which have been manually downloaded by someone else. This means that the convention is not always the same! However, there is always one part of the filename that is the same.

EG: ABC 0455805919-062.csv will be downloaded the next month as GBV 0455805919-063.csv. The first part of the name will change, and the last part after the '-' increments by 1 each month.

What i would like is some VBA to rename the files using a predetermined list.

EG, always rename any file containing "0455805919" (the middle bit of the filename above) to fileone.csv

I've played about with the 'name' option in VBA so I can rename files with , but am struggling with the changing filenames. Does anyone have any ideas that could help me? Sorry if I'm not being 100% clear!

Thanks very much.

**JBeaucaire** · 08-10-2009, 01:59 PM

Here are two macros to deal with both needs.

The first creates the list of files for you in column A.
The second renames the files based on the values in column B.

The attached worksheet even offers a suggestion on making the conversion using a simple formula in B1 of:
=IF(A1="", "", LOOKUP(MID(A1,FIND(" ",A1)+1,10),D:D,E:E ))

A chart in column D:E with your search strings and your desired output filenames gives the formula what it needs to provide the answers.

Option Explicit

Sub ListFiles()
'JBeaucaire (8/10/2009)
'Lists all files in given folder in column A
Dim i As Long, fList

'Clear old listing
Range("A:A").ClearContents

'Path
ChDir Range("G1").Value

'Check to see if there are any matching files to list
If Not Dir("*.csv") = "" Then
    fList = Dir("*.csv")
    i = 1
    
    Do Until fList = ""     'List files in column A
        Cells(i, 1).Value = fList
        i = i + 1
        fList = Dir
    Loop

End If

End Sub

Sub RenameFiles()
'JBeaucaire (8/10/2009)
'Renames files listed in column A with names from column B in given folder
Dim i As Long, c As Long, oName As String, nName As String

ChDir Range("G1").Value

For i = 1 To Range("A1").End(xlDown).Row
    
    oName = Cells(i, 1).Value
    nName = Cells(i, 2).Value
    
    If Not Dir(oName) = "" Then
        Name oName As nName
        c = c + 1
Next

MsgBox "Done, " & c & " files renamed."

End Sub