Need VBA code (EXCEL or MS ACCESS) to rename files with information found in cells in a spreadsheet

TechGuise
TechGuise used Ask the Experts™
on
I need to use Excel VBA to rename files in a folder based on two columns in a spreadsheet.  This is to add a "BATES" number for a legal proceeding.  
If no EXCEL experts have a solution, I would also welcome a solution that works in MS Access.

So the original file name is in COLUMN B, the information I want to add to each filename is in COLUMN A

FYI....
I brought the list in COLUMN B by doing a "dir *.tif /on /b >tiflist.txt" from a command line, then copy and pasted the contents of the text file into excel.

Ideally it would copy the file to a new location, renaming it along the way.... but if it renames it "in place", thats ok too.

Thanks in advance for any help.Simple spreadsheet of list of files needing renamed
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Bill PrewTest your restores, not your backups...
Top Expert 2016

Commented:
What should the new file name be, for example on row 1?

  • 0000000001_100274_57213.tif
  • 100274_57213_0000000001.tif
  • other?


»bp

Author

Commented:
0000000001_100274_57213.tif
Bill PrewTest your restores, not your backups...
Top Expert 2016

Commented:
If it were me, I would just add this formula to column C,

=CONCATENATE("copy ""c:\dir1\",B1,""" ""c:\dir2\", A1, B1, """")

copy down as needed, then copy column C into Notepad or a text editor and save as a simple .BAT file.  At a command prompt run that .BAT file.

Right now it will build lines that look like:

copy "c:\dir1\100274_57213.tif" "c:\dir2\0000000001_100274_57213.tif"

Adjust the paths in the CONCATENATE() to reference your source and destination folder (make sure dest folder exists).  It will copy the files to the new folder and give them the new name in the process.


»bp

Author

Commented:
Interesting method.  
I can definitely see how that will work.    

But I'd rather make something more easily repeatable and something I can eventually add some checks and confirmations too.  I'm afraid if the batch file fails, it will just fail....   with no real feedback on issue or any kind of placeholder.
John TsioumprisSoftware & Systems Engineer

Commented:
Well Excel should be fine but if you want real control then Access is much better
Take a look at my Attachment
Just put some files in the "Source" Folder and they will be Renamed in the "Renamed" Folder
Because i don't have handy something like the Excel data you showed i just added some Random numbers and "ABC"
You can tweak it to your liking
EE.zip

Author

Commented:
Thanks John for the reply.

I'm not seeing how that will add information from adjacent fields.   That is the part of the code that I don't know how to do.

If you happen to reply again, would you mind posting the code in your response (downloading and extracting a zip file is a little cumbersome)

Thanks very much for help.
John TsioumprisSoftware & Systems Engineer

Commented:
Here is the code
Private Sub cmdFindAndRename_Click()
Dim InputFile As String
Dim OutputFile As String
Dim strFile As String

    strFile = Dir(Application.CurrentProject.Path & "\Source\")
    Do While Len(strFile) > 0
    FileCopy Application.CurrentProject.Path & "\Source\" & strFile, Application.CurrentProject.Path & "\Renamed\" & strFile
    Name Application.CurrentProject.Path & "\Renamed\" & strFile As Application.CurrentProject.Path & "\Renamed\" & Rnd(100) & "ABC" & strFile
        strFile = Dir

    Loop
End Sub

Open in new window

Probably you need to pay attention to the following lines
  • strFile = Dir(Application.CurrentProject.Path & "\Source\") --> Here you pickup the 1st file in Folder...you can do a check to see if it matches your file (like Excel)
  • FileCopy Application.CurrentProject.Path & "\Source\" & strFile, Application.CurrentProject.Path & "\Renamed\" & strFile  -- > I do a copy from Source to Renamed
  • Name Application.CurrentProject.Path & "\Renamed\" & strFile As Application.CurrentProject.Path & "\Renamed\" & Rnd(100) & "ABC" & strFile  --> The Actual Renaming...From the Original Named File to the Renamed one ...you can do whatever match you want.
Test your restores, not your backups...
Top Expert 2016
Commented:
Here's a slightly different approach, take a look and see if it makes sense and might meet your needs.  The worksheet contains the path to the from and to folders, and then the list of file names and prefaces like what you showed in the question.  Click the button to do the copy and renames.  Some basic error checking is included that you can enhance as needed.  Nothing too fancy but should be a decent starting point...

EE29168846.xlsm
sshot-13.png
Option Explicit

Sub CopyFiles()
    ' Local variables
    Dim FSO As Object
    Dim BaseDir As String
    Dim DestDir As String
    Dim LastRow As Integer
    Dim i As Integer
    Dim FromPath As String
    Dim ToPath As String
    
    ' Override default "green" with a better slightly darker shade
    Const vbGreen = -11489280

    ' Let VBA handle errors by default
    On Error GoTo 0

    ' Create filesystem object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' Get paths to source folder and make sure it exists
    BaseDir = Range("B1").Value
    If Not FolderExists(FSO, BaseDir) Then
        Exit Sub
    End If
    
    ' Get paths to destination folder and make sure it exists
    DestDir = Range("B2").Value
    If Not FolderExists(FSO, DestDir) Then
        Exit Sub
    End If
    
    ' Find last row of data to process
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Clear out status message column
    Range("C5:C" & LastRow).Value = ""
    Range("C5:C" & LastRow).Font.Color = vbBlack
    
    ' Process all file names to copy and rename
    For i = 5 To LastRow
        ' Skip any blank rows
        If Range("A" & i).Value <> "" Then
        
            ' Build full path for from and to files
            FromPath = BaseDir & "\" & Range("B" & i).Value
            ToPath = DestDir & "\" & Range("A" & i).Value & Range("B" & i).Value
            
            ' Make sure old file exists
            If FSO.FileExists(FromPath) Then
                ' Copy file (trap errors)
                On Error Resume Next
                FSO.CopyFile FromPath, ToPath, False
                If Err.Number <> 0 Then
                    Range("C" & i).Value = "Error: " & Err.Number & " (" & Err.Description & ")"
                    Range("C" & i).Font.Color = vbRed
                Else
                    Range("C" & i).Value = "File copied"
                    Range("C" & i).Font.Color = vbGreen
                End If
                On Error GoTo 0
            Else
                Range("C" & i).Value = "Source file missing"
                Range("C" & i).Font.Color = vbRed
            End If
        
        End If
    Next
    
    MsgBox "Done!"
    
End Sub

Function FolderExists(FSO As Object, FolderPath As String) As Boolean
    If FSO.FolderExists(FolderPath) Then
        FolderExists = True
    Else
        MsgBox "ERROR: Folder does not exist - " & FolderPath
        FolderExists = False
    End If
End Function

Open in new window


»bp

Author

Commented:
Thanks guys!  
Bill - Exactly what I was looking for.   The outcome of each file was needed more than I knew (colors where a real nice touch)

John - I'm sure you solution would have worked, but I couldn't get my brain past the Rnd() and figure out the code to grab info from adjacent column.   Simple once I saw it done.  doh!
The COPY method was actually pretty ingenious.... bet I use that in the future for quick fixes.

Thanks again gentlemen
Bill PrewTest your restores, not your backups...
Top Expert 2016

Commented:
Welcome, glad that was helpful, and thanks for the feedback.


»bp

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial