Rename many TIF files in multiple folders based on info in spreadsheet or csv file

I need to rename 12,000 TIF files located in various folders (all under one main folder) so that instead of having a numeric name (01234.TIF) they will have a name that makes sense. The existing file name (including full  path) is in one column of the spreadsheet and the new file name is in another, but it  does not contain the path or file extension.  Included in the folders are files that do not need to be renamed (e.g. they may be Word docs, or some other type that has a good file name already). The spreadsheet contains the file names of all the documents (28,000). Thank you for any help you can give with this problem!
jswilkinszAsked:
Who is Participating?
 
ahammarConnect With a Mentor Commented:
Oops...I goofed...here is the corrected code and file to rename all the tif files...



Sub RenameFiles()
Dim OldFname As String
Dim NewFname As String
Dim DotPos As Integer
Dim r As Range
Dim MaxRow As Long
Dim Ext As String
Dim fPath As String
Dim LastSlash As Integer
 
Set r = Range("A1") 'First cell with old path and filename
 
MaxRow = Range("A" & Cells.Rows.Count).End(xlUp).Row
 
Do Until r.Row > MaxRow
    If r.Value <> "" Then
        If Dir$(r.Value) <> "" Then
            OldFname = r.Value
            DotPos = Len(OldFname) - InStrRev(OldFname, ".")
            Ext = Right(OldFname, DotPos) 'extension of filename
            If LCase(Ext) = "tif" Then
                NewFname = r.Offset(0, 1).Value
                
                If DotPos = Len(OldFname) Then DotPos = 0
                LastSlash = Len(OldFname) - InStrRev(OldFname, "\")
                
                fPath = Left(OldFname, Len(OldFname) - LastSlash) 'Path to the file with last backslash
                Name OldFname As fPath & NewFname & "." & Ext
            End If
        Else
            r.Interior.ColorIndex = 36
        End If
        
        Set r = r.Offset(1, 0)
    End If
Loop
 
 
End Sub

Open in new window

RenameFiles-2.xls
0
 
nutschCommented:
Can we assume that all the files that have a new name (in the second column) are .tif and need to be renamed?

Thomas
0
 
ahammarCommented:
Here is a macro  that will do it for you...but it is written assuming that your list of old names starts in A1, and the list of new names is in B1.  I will also upload a sample file that is already working, but you will have to put some real paths and filenames in column A...of course the ones I put in you will not have...

If you have any questions, or if I misunderstood exactly what you want, then let me know..

:-)
Albert


Sub RenameFiles()
Dim OldFname As String
Dim NewFname As String
Dim DotPos As Integer
Dim r As Range
Dim MaxRow As Long
Dim Ext As String
Dim fPath As String
Dim LastSlash As Integer
 
Set r = Range("A1") 'First cell with old path and filename
 
MaxRow = Range("A" & Cells.Rows.Count).End(xlUp).Row
 
Do Until r.Row > MaxRow
    If r.Value <> "" Then
        If Dir$(r.Value) <> "" Then
            OldFname = r.Value
            NewFname = r.Offset(0, 1).Value
            
            DotPos = Len(OldFname) - InStrRev(OldFname, ".")
            If DotPos = Len(OldFname) Then DotPos = 0
            LastSlash = Len(OldFname) - InStrRev(OldFname, "\")
            
            fPath = Left(OldFname, Len(OldFname) - LastSlash) 'Path to the file with last backslash
            Ext = Right(OldFname, DotPos) 'extension of filename
            Name OldFname As fPath & NewFname & "." & Ext
        Else
            r.Interior.ColorIndex = 36
        End If
        
        Set r = r.Offset(1, 0)
    End If
Loop
 
 
End Sub

Open in new window

RenameFiles.xls
0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

 
jswilkinszAuthor Commented:
No, they aren't. All the files are there, although it would be possible to just select the TIF files in the spreadsheet. But the files in the folders are tif, word, etc. Thank you.
0
 
ahammarCommented:
I just noticed that you said your Excel sheet contains all the files, even the ones that don't need renamed...what criteria can we use to decide if a file does or does not get renamed...my above macro will rename every file listed in column A.
It will take very little editing to make it work the way you want.  Do the files that you have listed that you do NOT want renamed, also have a value in the column where the new names are...how about if it just renames all files that have a new name listed in the new name column??...or whatever criteria you can give me to tell the macro how to decide...is it simply just all TIFF files??

:-)
Albert
0
 
ahammarCommented:
Here is a new macro and file...it is the same thing except it only renames the .tif files

Sub RenameFiles()
Dim OldFname As String
Dim NewFname As String
Dim DotPos As Integer
Dim r As Range
Dim MaxRow As Long
Dim Ext As String
Dim fPath As String
Dim LastSlash As Integer
 
Set r = Range("A1") 'First cell with old path and filename
 
MaxRow = Range("A" & Cells.Rows.Count).End(xlUp).Row
 
Do Until r.Row > MaxRow
    If r.Value <> "" Then
        If Dir$(r.Value) <> "" Then
            Ext = Right(OldFname, DotPos) 'extension of filename
            If LCase(Ext) = "tif" Then
                OldFname = r.Value
                NewFname = r.Offset(0, 1).Value
                
                DotPos = Len(OldFname) - InStrRev(OldFname, ".")
                If DotPos = Len(OldFname) Then DotPos = 0
                LastSlash = Len(OldFname) - InStrRev(OldFname, "\")
                
                fPath = Left(OldFname, Len(OldFname) - LastSlash) 'Path to the file with last backslash
                Name OldFname As fPath & NewFname & "." & Ext
            End If
        Else
            r.Interior.ColorIndex = 36
        End If
        
        Set r = r.Offset(1, 0)
    End If
Loop
 
End Sub

Open in new window

RenameFiles-2.xls
0
 
jswilkinszAuthor Commented:
Perfect - thank  you so much!
0
 
jswilkinszAuthor Commented:
This is just what was needed, and thank you for such a quick response, and for modifying to take into account the TIF extension.
0
 
ahammarCommented:
Good....You're welcome, and thanks for the points and the grade!  If something unexpected comes up and you need any minor changes, you can still come back here and let me know...

:-)
Albert
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.