Solved

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

Posted on 2008-10-15
9
353 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Transaction Monitoring Vs. Real User Monitoring

Synthetic Transaction Monitoring Vs. Real User Monitoring: When To Use Each Approach? In this article, we will discuss two major monitoring approaches: Synthetic Transaction and Real User Monitoring.

 
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

The Ultimate Checklist to Optimize Your Website

Websites are getting bigger and complicated by the day. Video, images, custom fonts are all great for showcasing your product/service. But the price to pay in terms of reduced page load times and ultimately, decreased sales, can lead to some difficult decisions about what to cut.

Question has a verified solution.

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

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
How to create a custom search shortcut to site-search Experts Exchange using Google in the Firefox browser. This eliminates the need to type out site:experts-exchange.com whenever you want to search the site. Launch your Bookmark Menu: Press 'Ctrl +…

696 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