Solved

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

Posted on 2008-10-15
9
344 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
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
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

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

I had to do a bit of research to find the answer to this question so I thought I'd share my results.  Due to our outdated mainframe systems, we need to downgrade IE9 to IE8 in order to stay compatible.  We also needed to downgrade Java.  In order to…
This article offers some helpful and general tips for safe browsing and online shopping. It offers simple and manageable procedures that help to ensure the safety of one's personal information and the security of any devices.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
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…

758 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

21 Experts available now in Live!

Get 1:1 Help Now