Option Explicit
Private Const STARTROW As Long = 5
Enum ColumnHeaders
SourceFolder = 2
originalfilename = 3
DestinationFolder = 5
NewFilename = 6
changedfilename = 8
End Enum
Private Counter As Long
Private CurrentRow As Long
Private NumberFiles As Long
Sub AddFiles()
Dim FSO As Object
Dim TargetFolder As Object
Dim TargetFolderName As Variant
Dim TargetFile As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
TargetFolderName = BrowseFolder("Select source folder")
If Len(TargetFolderName) Then
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Set TargetFolder = FSO.GetFolder(TargetFolderName)
For Each TargetFile In TargetFolder.Files
DoEvents
Master.Cells(Counter + STARTROW, ColumnHeaders.SourceFolder) = TargetFolderName
Master.Cells(Counter + STARTROW, ColumnHeaders.originalfilename) = TargetFile.Name
Counter = Counter + 1
Next
End If
Master.Range("FileCount").Value = Counter
NumberFiles = Counter
ErrHandler:
Application.ScreenUpdating = True
Set FSO = Nothing
Set TargetFolder = Nothing
Set TargetFile = Nothing
If Err.Number <> 0 Then MsgBox "Error " & Err.Number & vbNewLine & vbNewLine & Err.Description
End Sub
Sub SelectDestinationFolder()
Dim DestinationFoldername As String
DestinationFoldername = BrowseFolder("Select destination folder")
If Len(DestinationFoldername) Then
Master.Cells(STARTROW, DestinationFolder).Resize(NumberFiles).Value = DestinationFoldername
End If
End Sub
Function BrowseFolder(Optional ByVal DialogTitle As String = "Select folder", Optional RootCSIDL As Long = 0) As String
On Error GoTo ErrHandler
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = DialogTitle
.ButtonName = "Select Folder"
If .Show = -1 Then ' if OK is pressed
BrowseFolder = .SelectedItems(1)
End If
End With
ErrHandler:
If Err.Number <> 0 Then MsgBox "Error " & Err.Number & vbNewLine & vbNewLine & Err.Description
End Function
Sub RenameFiles()
Application.ScreenUpdating = False
Dim FileSet As Variant
Dim OrignalFilePath As String
Dim NewFilePath As String
Dim RenamedCount As Long
On Error GoTo ErrHandler
FileSet = Master.Range(Master.Cells(STARTROW, SourceFolder), Master.Cells(STARTROW + NumberFiles, NewFilename)).Value
For Counter = 1 To NumberFiles
If Len(FileSet(Counter, 5)) Then
OrignalFilePath = CheckFilePath(FileSet(Counter, 1), FileSet(Counter, 2))
NewFilePath = CheckFilePath(FileSet(Counter, 4), FileSet(Counter, 5))
Name OrignalFilePath As NewFilePath
If Len(Dir(NewFilePath)) Then
Master.Cells(Counter + STARTROW - 1, changedfilename).Value = "Done"
Master.Range(Master.Cells(Counter + STARTROW - 1, SourceFolder), Master.Cells(Counter + STARTROW - 1, originalfilename)).Font.Color = XlRgbColor.rgbDarkGrey
RenamedCount = RenamedCount + 1
End If
End If
Next
Master.Range("RenamedCount") = RenamedCount
ErrHandler:
Application.ScreenUpdating = True
If Err.Number <> 0 Then MsgBox "Error " & Err.Number & vbNewLine & vbNewLine & Err.Description
End Sub
Sub ClearSheet()
Master.Range(Master.Cells(STARTROW, SourceFolder), Master.Cells(Master.Rows.Count, NewFilename + 2)).Clear
Master.Range("FileCount").Value = ""
Master.Range("RenamedCount").Value = ""
Counter = 0
CurrentRow = 0
NumberFiles = 0
End Sub
Function CheckFilePath(ByVal FolderPart As String, ByVal FilenamePart As String)
If Right(FolderPart, 1) <> Application.PathSeparator Then FolderPart = FolderPart & Application.PathSeparator
CheckFilePath = FolderPart & FilenamePart
End Function