Solved

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

Posted on 2008-10-15
9
351 Views
Last Modified: 2013-12-08
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!
0
Comment
Question by:jswilkinsz
  • 5
  • 3
9 Comments
 
LVL 39

Expert Comment

by:nutsch
ID: 22726009
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
 
LVL 23

Expert Comment

by:ahammar
ID: 22726076
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
 

Author Comment

by:jswilkinsz
ID: 22726079
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
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
LVL 23

Expert Comment

by:ahammar
ID: 22726148
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
 
LVL 23

Expert Comment

by:ahammar
ID: 22726259
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
 
LVL 23

Accepted Solution

by:
ahammar earned 500 total points
ID: 22726319
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
 

Author Comment

by:jswilkinsz
ID: 22726328
Perfect - thank  you so much!
0
 

Author Closing Comment

by:jswilkinsz
ID: 31506496
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
 
LVL 23

Expert Comment

by:ahammar
ID: 22726424
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

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you come here a lot? Are you lazy like me and don't want to go through the "trouble" of having to click your Dock's Safari icon and then having to click your Experts Exchange Favorites bookmark to get here? Well then this article is for you.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

791 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question