Solved

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

Posted on 2008-10-15
9
346 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
 
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Ever notice how you can't use a new drive in Windows without having Windows assigning a Disk Signature?  Ever have a signature collision problem (especially with Virtual Machines?)  This article is intended to help you understand what's going on and…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial will demonstrate how to add subdomains to your content reports. This can be very importing in having a site with multiple subdomains.
With the advent of Windows 10, Microsoft is pushing a Get Windows 10 icon into the notification area (system tray) of qualifying computers. There are many reasons for wanting to remove this icon. This two-part Experts Exchange video Micro Tutorial s…

939 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

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now