Solved: renaming files using excel

[livelike]

This post is mainly intended for XL Gibbs, as I already sent him an email about this. But of course, if anyone has any comments, please let me know.

I'm looking for a template or Excel add-in that may rename multiple files from a directory (including subfolders), using a list of names in Excel. I do work like a large number of files (mostly jpg?s), that need to be renamed to specific names, and the vlookup and sort functions could make my life a lot easier, if I could first specify a directory and create a list of all files in that directory, and then specify the desired name in the corresponding cell of the following column.

I have attached a sample .xls file of what I'm talking about. Thank you in advance!!!

[XLGibbs]

I am on it... Thanks for posting the question so others may be able to learn from the situation....

give me about oh, 20 minutes max.

[Bob Phillips]

Here's some code to rename the files

[vba]
Sub RenameFiles()
Dim iLastRow As Long
Dim i As Long
Dim sNew As String
Dim sOld As String

With Worksheets("Sheet1")
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To iLastRow
If .Cells(i, "C").Value <> "" Then
sOld = .Cells(i, "A").Value & .Cells(i, "B").Value
sNew = .Cells(i, "A").Value & .Cells(i, "C").Value
On Error Resume Next
Name sOld As sNew
On Error GoTo 0
End If
Next i
End With
End Sub
[/vba]

[XLGibbs]

Here is the template you requested. Advise as to modifications needed.

You can double click column A to popualte a list after browsing to a directory, with the files found in that directory.

When you hit rename, it will rename the files where a rename is specified and tag the status field.

Clear contents button, does just that.

Let me know.

Here is the quick code for anyone curious....a sheet before double click passes the target to the main routine
[vba]
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'''Code from kpuls, www.VBAExpress.com..portion of Knowledge base submission

Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

Set ShellApp = Nothing

Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select

Exit Function
Invalid:
MsgBox "Invalid Path, retry"

End Function

Sub PopulateDirectoryList(ByVal rngDir As Range)

Dim objFSO As FileSystemObject, objFolder As Folder
Dim objFile As File, strSourceFolder As String, x As Long

ToggleStuff False

Set objFSO = New FileSystemObject 'set a new object in memory
strSourceFolder = BrowseForFolder

Set objFolder = objFSO.GetFolder(strSourceFolder) 'get the folder
x = 0
For Each objFile In objFolder.Files
rngDir.Offset(x, 0) = strSourceFolder
rngDir.Offset(x, 1) = objFile.Name
x = x + 1
Next objFile

Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing

ToggleStuff True
End Sub
Sub ToggleStuff(ByVal x As Boolean)
Application.ScreenUpdating = x
Application.EnableEvents = x
End Sub

Sub RenameUs()

Dim objFSO As FileSystemObject, c As Range
Dim strSourceFolder As String
Dim rngFileList As Range

Set objFSO = New FileSystemObject 'set a new object in memory

ToggleStuff False
With ActiveSheet

Set rngFileList = Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)

For Each c In rngFileList

If c.Offset(, 2) <> "" Then 'if the rename is empty move on
strFileName = c.Offset(, 1) 'set the file name, column B
strSourceFolder = c 'set the folder name, columnB
strRename = c.Offset(, 2)

'copy file with new name
On Error GoTo Skip
objFSO.CopyFile strSourceFolder & "\" & strFileName, strSourceFolder & "\" & strRename, True
objFSO.DeleteFile (strSourceFolder & "\" & strFileName)

c.Offset(, 3) = "Renamed"
Else:
Skip:
c.Offset(, 3) = "Skipped"
End If


Next c
End With

Set objFSO = Nothing: Set rngFileList = Nothing

ToggleStuff True
End Sub

Sub ClearList()

With ActiveSheet
.Range("A2" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
End With

End Sub
[/vba]

[mdmackillop]

Hi Livelike,
Welcome to VBax
Here's an alternative solution based on what I recall of another photo thing I did a long time ago. Its a little bit rough.
Added features:
Click on a filename to see a picture
Enter newname in column C and it renames automatically.
Regards
MD

[livelike]

XL Gibbs, Xld and Mdmackillop THANK YOU!



I just tried all samples and:

XL Gibbs, for some reason files in subfolders not all files are getting listed after selecting an specific directory. I have a directory with 5 sublevels (with a total of 300 png files), and only the files on the top are getting listed. Is there something that needs to be changed in the code to do this? It would be great if there could be a check box, to give you the option to work with subfolders or not?.



Also if for some reason, if I do select an empty folder, I get a error message ?invalid path ? retry? and then the debug message shows the line ?Set objFolder = objFSO.GetFolder(strSourceFolder) 'get the folder?. After this, nothing would happen if I double click at coloumn A (in order to show the directory selection). Even after closing the file without changes and reopening nothing happens, only after closing and reopening Excel itself, it comes back to normal. This is not a mayor issue, just wanted to let you know about it.


Mdmackillop, I have the same issue with the subfolders as mentioned above.

[XLGibbs]

XL Gibbs, Xld and Mdmackillop THANK YOU!



I just tried all samples and:

XL Gibbs, for some reason files in subfolders not all files are getting listed after selecting an specific directory. I have a directory with 5 sublevels (with a total of 300 png files), and only the files on the top are getting listed. Is there something that needs to be changed in the code to do this? It would be great if there could be a check box, to give you the option to work with subfolders or not?.



Also if for some reason, if I do select an empty folder, I get a error message ?invalid path ? retry? and then the debug message shows the line ?Set objFolder = objFSO.GetFolder(strSourceFolder) 'get the folder?. After this, nothing would happen if I double click at coloumn A (in order to show the directory selection). Even after closing the file without changes and reopening nothing happens, only after closing and reopening Excel itself, it comes back to normal. This is not a mayor issue, just wanted to let you know about it.


Mdmackillop, I have the same issue with the subfolders as mentioned above.

This won't work for subfolders as written..you did not mention that...but there is another option, will shoot back alternative in a few minutes...

I will also fix the issue of if it errors out. What happens is events are disabled during the routine, and if it errors, I forgot to tell them to turn back on so you could try again. Sit tight for about 10 minutes.....will get you sorted...

[XLGibbs]

Here ya go...made a few changes to resolve some of the issue you mentioned. Right now it is looking for all files...

because of this:

.FileType = msoFileTypeAllFiles

which be changed to

.FileName = "*.jpg"

for example to find only .jpg files


[VBA]
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'''Code from kpuls, www.VBAExpress.com..portion of Knowledge base submission

Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

Set ShellApp = Nothing

Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
ToggleStuff True
Exit Function

Invalid:
MsgBox "Invalid Path, retry"

ToggleStuff True

End Function

Sub PopulateDirectoryList(ByVal rngDir As Range)

Dim objFSO As FileSystemObject, objFolder As Folder
Dim objFile As File, strSourceFolder As String, x As Long
Dim strPath As String, strFile As String, pos

ToggleStuff False

Set objFSO = New FileSystemObject 'set a new object in memory
strSourceFolder = BrowseForFolder

With Application.FileSearch
.LookIn = strSourceFolder
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.Execute

For x = 1 To .FoundFiles.Count
'set incidental variables
On Error GoTo Skip
pos = InStrRev(.FoundFiles(x), "\")
strFile = Right(.FoundFiles(x), Len(.FoundFiles(x)) - pos)
strPath = Left(.FoundFiles(x), pos)

rngDir.Offset(x, 0) = strPath
rngDir.Offset(x, 1) = strFile

Skip:
'this is in case a Permission denied error comes up or something.
Next x

End With

Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing

ToggleStuff True
End Sub
Sub ToggleStuff(ByVal x As Boolean)
Application.ScreenUpdating = x
Application.EnableEvents = x
End Sub

Sub RenameUs()

Dim objFSO As FileSystemObject, c As Range
Dim strSourceFolder As String
Dim rngFileList As Range

Set objFSO = New FileSystemObject 'set a new object in memory

ToggleStuff False
With ActiveSheet

Set rngFileList = Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)

For Each c In rngFileList

If c.Offset(, 2) <> "" Then 'if the rename is empty move on
strFileName = c.Offset(, 1) 'set the file name, column B
strSourceFolder = c 'set the folder name, columnB
strRename = c.Offset(, 2)

'copy file with new name
On Error GoTo Skip
objFSO.CopyFile strSourceFolder & "\" & strFileName, strSourceFolder & "\" & strRename, True
objFSO.DeleteFile (strSourceFolder & "\" & strFileName)

c.Offset(, 3) = "Renamed"
Else:
Skip:
c.Offset(, 3) = "Skipped"
End If


Next c
End With

Set objFSO = Nothing: Set rngFileList = Nothing

ToggleStuff True
End Sub

Sub ClearList()

With ActiveSheet
.Range("A2" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
End With

End Sub
[/vba]

[livelike]

XL Gibbs THANK YOU!!!! AND THANK YOU AGAIN!!!! This is exactly what I was looking for! = )



I just tried changing the subfolder option to false and setting the search option to only to a specific type of file and it is just awesome! Tedious batch file renaming will never be the same again!



And yes the problem issue with the empty folder was fixed as mentioned!!!



thanks to each of you guys on this thread as well!!!

[XLGibbs]

Just happy to be of assistance. Thanks for taking the time to look at my KB submission which prompted the email and the subsequent discussion. I think we all learned something

Just finish the thread off using thread tools and rate it if you want and mark it solved

Thanks Dave!

[mdmackillop]

I've unashamedly stolen Pete's code and incorporated it into my Preview version.
The rename facility is still there as well, but not as a "bulk" item. Just enter the new name into column C. I've posted a question regarding correcting picture orientation. I don't know if this can be done from within Excel.
Regards
Malcolm

[livelike]

Wow!!! This file renaming utility is becoming a truly outstanding tool!! It just gets better and better!!



As mentioned before, Excel gives user a great deal of flexibility in the renaming process, such as ability to use the sort, lookup, trim, concatenate, and all other useful features, that most file renaming utilities do not offer, or do not provide the vast options available in Excel.



Malcom, here are just a couple of suggestions:

If you accidentally select to cells in the column ?B? an error message pops up (as I guess the code will try to show 2 snap at the same time). Could there be an option that in case that two or more cells are selected, only the snap of the active cell will be displayed, avoiding the error message?



The clear list code, needs to be assigned to a button, No big deal = )



In case that the code is changed to look for all types or files (other than image types), there is a debug message, is it possible exclude the preview process of all non image files, or just show the file?s icon instead?



Could there be a pause or hold button on the instant renaming process? Just for last minute change of mind? Personally I do like a lot the renaming button and status column that Pete implemented, because it give you more time do to final name changes, please don't get me wrong, I know this is up to you, and I thank you for your help!! = )

[livelike]

sorry for the big font, I copied the text from word

[mdmackillop]

I think this will end upn as a KB item, with Pete's agreement, so there may be a few more bells and whistles. I can add a name change confirmation for typos, but as they go one at a time, you can just retype the new name in any case. I've added a simple delete facility, which I've found useful in the past. I'll give some thought to the other items, but I would see this mainly as a picture handler. Interesting thought on the other file types though, especially a preview option. This could go on another sheet.

[mdmackillop]

Works fine with other file types. Need a bit fine tuning though.

[XLGibbs]

Permission granted

[mdmackillop]

Here's a version which permits the rotation of pictures, saving them with the new orientation using a 3rd party application.

[papajam]

Great code!

[papajam]

Let me rephrase, AWESOM! I can now rename files based on a vlookup, amazing! Thanks.

[gdmerioles]

Hello guys could I get a copy of the excel template for my project... It would be much appreciated.