Excel VBA Copy files code - vba

Question

Could anyone help me to modify the script below to do the following:
Currently if there is an image with the same name in two different folders and with two different sizes, the program will completely skip the image if the first version found does not match the file size required.
I would like it to skip the small size image however if it comes across the same name in another folder with the right image size, it would copy it.
Here is the full program code:
Option Explicit
Const fileListRow = 1
Const fileListCol = 2
Const srcDirRow = 2
Const srcDirCol = 2
Const destDirRow = 3
Const destDirCol = 2
Const resultRow = 4
Const resultListCol = 1
Const resultFoundCol = 2
Const resultCopyCol = 3
Const percentageRow = 5
Const percentageCol = 4
Const fileSizeLimitRow = 4
Const fileSizeLimitCol = 5
Dim srcFileShortName As String
Dim srcFileFullName As String
Dim destFileFullName As String
Dim srcDir As String
Dim destDir As String
Const startRowSrcFileShortName = 7
Dim endRowSrcFileShortName As Long
Const startRowSrcFileFullName = 7
Const startColSrcFileFullName = 2
Dim endRowSrcFileFullName As Long
Dim searchFileAmount As Long
Dim foundFileAmount As Long
Dim copyFileAmount As Long
Dim fileSizeLimit As Long
Dim totalCopyFileSize As Long
Dim currentCopyFileSize As Long
Dim mainWS As Worksheet
Sub getFileList()
Set mainWS = ThisWorkbook.Sheets("main")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
mainWS.Unprotect
Dim x As Variant
x = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), *.txt", Title:="Choose File List", MultiSelect:=False)
If x = False Then
Exit Sub
End If
ThisWorkbook.Sheets("main").Cells(fileListRow, fileListCol).Value = x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
mainWS.Protect
End Sub
Sub getSrcDir()
Set mainWS = ThisWorkbook.Sheets("main")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
mainWS.Unprotect
Dim folderPath As String
Dim result As Integer
Dim dialog As Office.FileDialog
Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
dialog.InitialFileName = ""
result = dialog.Show()
If result = -1 Then
ThisWorkbook.Sheets("main").Cells(srcDirRow, srcDirCol).Value = dialog.SelectedItems(1)
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
mainWS.Protect
End Sub
Sub getDestDir()
Set mainWS = ThisWorkbook.Sheets("main")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
mainWS.Unprotect
Dim folderPath As String
Dim result As Integer
Dim dialog As Office.FileDialog
Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
dialog.InitialFileName = ""
result = dialog.Show()
If result = -1 Then
ThisWorkbook.Sheets("main").Cells(destDirRow, destDirCol).Value = dialog.SelectedItems(1)
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
mainWS.Protect
End Sub
Sub resetField()
Dim totalRow As Long
Set mainWS = ThisWorkbook.Sheets("main")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
mainWS.Unprotect
mainWS.Cells(resultRow, resultListCol).Resize(1, 3).ClearContents
mainWS.Cells(percentageRow, percentageCol).Resize(1, 3).ClearContents
endRowSrcFileShortName = mainWS.Cells(mainWS.Rows.Count, 1).End(xlUp).Row
totalRow = endRowSrcFileShortName - startRowSrcFileShortName + 1
If totalRow > 0 Then
mainWS.Cells(startRowSrcFileShortName, 1).Resize(totalRow, 3).ClearContents
mainWS.Cells(startRowSrcFileShortName, 1).Resize(totalRow, 3).Interior.ColorIndex = xlColorIndexNone
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
mainWS.Protect
End Sub
Sub FindFile()
Call resetField
Dim counter As Long
Set mainWS = ThisWorkbook.Sheets("main")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
mainWS.Unprotect
Dim fileName As String, textRow As String, fileNo As Integer
fileName = mainWS.Cells(fileListRow, fileListCol)
fileNo = FreeFile 'Get first free file number
counter = startRowSrcFileShortName
Open fileName For Input As #fileNo
Do While Not EOF(fileNo)
Line Input #fileNo, textRow
mainWS.Cells(counter, 1).Value = textRow
counter = counter + 1
Loop
Close #fileNo
srcDir = mainWS.Cells(srcDirRow, srcDirCol).Value
endRowSrcFileShortName = mainWS.Cells(mainWS.Rows.Count, 1).End(xlUp).Row
searchFileAmount = 0
For counter = startRowSrcFileShortName To endRowSrcFileShortName
srcFileShortName = mainWS.Cells(counter, 1).Value
If srcFileShortName <> "" Then
searchFileAmount = searchFileAmount + 1
End If
Next counter
mainWS.Cells(resultRow, 1).Value = searchFileAmount & " Files Searched"
If searchFileAmount > 0 Then
foundFileAmount = 0
For counter = startRowSrcFileShortName To endRowSrcFileShortName
srcFileShortName = mainWS.Cells(counter, 1).Value
If srcFileShortName <> "" Then
srcFileFullName = ""
Call FindFileName1(srcDir)
Call FindFileName2(srcDir)
If srcFileFullName = "" Then
mainWS.Cells(counter, startColSrcFileFullName).Value = "N/A"
mainWS.Cells(counter, startColSrcFileFullName).Interior.Color = RGB(255, 0, 0)
Else
mainWS.Cells(counter, startColSrcFileFullName).Value = srcFileFullName
foundFileAmount = foundFileAmount + 1
End If
Else
mainWS.Cells(counter, startColSrcFileFullName).Value = "N/A"
End If
Next counter
End If
mainWS.Cells(resultRow, resultFoundCol).Value = foundFileAmount & " Files Found"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
mainWS.Protect
End Sub
Private Function FindFileName1(srcDir) '²éÕÒԴ·¾¶
Dim fso, fld, fsb
Dim fd, f
If srcFileFullName <> "" Then Exit Function 'ÕÒµ½ºóÍ˳ö
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(srcDir)
For Each f In fld.Files '±éÀúÔ´Îļþ¼ÐÖеÄËùÓÐÎļþ
If CaseCheckBox.Value = True Then
If f.Name = srcFileShortName Then '±È½ÏÁ½¸öÎļþÃû£¬Çø·Ö´óСд
srcFileFullName = fld.Path & "\" & f.Name
Exit Function 'ÕÒµ½ºóÍ˳ö
End If
Else
If UCase(f.Name) = UCase(srcFileShortName) Then '±È½ÏÁ½¸öÎļþÃû,²»Çø·Ö´óСд
srcFileFullName = fld.Path & "\" & f.Name
Exit Function 'ÕÒµ½ºóÍ˳ö
End If
End If
Next
End Function
Private Function FindFileName2(srcDir) 'µÝ¹éËÑÑ°´úÂë
Dim fso, fld, fsb
Dim fd, f
If srcFileFullName <> "" Then Exit Function 'ÕÒµ½ºóÍ˳öµÝ¹é
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(srcDir)
Set fsb = fld.SubFolders
For Each fd In fsb '±éÀú¸ÃÎļþ¼ÐµÄËùÓÐ×ÓÎļþ¼Ð
For Each f In fd.Files '±éÀúÿ¸ö×ÓÎļþ¼ÐÖеÄËùÓÐÎļþ
If CaseCheckBox.Value = True Then
If f.Name = srcFileShortName Then '±È½ÏÁ½¸öÎļþÃû£¬Çø·Ö´óСд
srcFileFullName = fd.Path & "\" & f.Name
Exit Function 'ÕÒµ½ºóÍ˳öµÝ¹é
End If
Else
If UCase(f.Name) = UCase(srcFileShortName) Then '±È½ÏÁ½¸öÎļþÃû,²»Çø·Ö´óСд
srcFileFullName = fd.Path & "\" & f.Name
Exit Function 'ÕÒµ½ºóÍ˳öµÝ¹é
End If
End If
Next
Call FindFileName2(fd.Path) '±¾Îļþ¼Ð¼ì²éÍê±Ïºó£¬¼ÌÐøÉî²ãËÑËØÆä×ÓÎļþ¼Ð
Next
End Function
Sub CopyFile()
Dim counter As Long
Dim fileSize As Long
Set mainWS = ThisWorkbook.Sheets("main")
'Application.ScreenUpdating = False
Application.DisplayAlerts = False
mainWS.Unprotect
srcDir = mainWS.Cells(srcDirRow, srcDirCol).Value
endRowSrcFileFullName = mainWS.Cells(mainWS.Rows.Count, startColSrcFileFullName).End(xlUp).Row
copyFileAmount = 0
fileSizeLimit = mainWS.Cells(fileSizeLimitRow, fileSizeLimitCol).Value * 1024 * 1024
totalCopyFileSize = 0
currentCopyFileSize = 0
If foundFileAmount > 0 Then
For counter = startRowSrcFileFullName To endRowSrcFileFullName
srcFileFullName = mainWS.Cells(counter, startColSrcFileFullName).Value
If srcFileFullName <> "N/A" Then
fileSize = FileLen(srcFileFullName)
If fileSize >= fileSizeLimit Then
totalCopyFileSize = totalCopyFileSize + fileSize
End If
End If
Next counter
End If
If foundFileAmount > 0 Then
For counter = startRowSrcFileFullName To endRowSrcFileFullName
srcFileFullName = mainWS.Cells(counter, startColSrcFileFullName).Value
If srcFileFullName <> "N/A" Then
fileSize = FileLen(srcFileFullName)
If fileSize >= fileSizeLimit Then
destFileFullName = mainWS.Cells(destDirRow, destDirCol) & "\" & mainWS.Cells(counter, 1)
On Error Resume Next
FileCopy srcFileFullName, destFileFullName
If Err.Number <> 0 Then
mainWS.Cells(counter, resultCopyCol) = "Error"
mainWS.Cells(counter, resultCopyCol).Interior.Color = RGB(255, 0, 0)
Else
mainWS.Cells(counter, resultCopyCol) = "OK"
copyFileAmount = copyFileAmount + 1
currentCopyFileSize = currentCopyFileSize + fileSize
mainWS.Cells(percentageRow, percentageCol).Value = currentCopyFileSize / totalCopyFileSize
End If
Else
mainWS.Cells(counter, resultCopyCol) = "FileSize:" & fileSize & "Bytes,Skipped"
End If
End If
Next counter
End If
mainWS.Cells(resultRow, resultCopyCol).Value = copyFileAmount & " Files Copied"
'Application.ScreenUpdating = True
Application.DisplayAlerts = True
mainWS.Protect
End Sub