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]