Private Sub FindDuplicateFilesInFolder(ByVal FolderPath As String)
Dim FileDict As Object
Set FileDict = CreateObject("Scripting.Dictionary")
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1) ' Thay d?i n?u c?n thi?t
Dim LastRow As Long
LastRow = 1 ' B?t d?u ghi k?t qu? t? hàng d?u tiên
' Ghi tiêu d? c?t
ws.Cells(LastRow, 1).Value = "Ðuong dan file"
ws.Cells(LastRow, 2).Value = "Giá tri bam"
ws.Cells(LastRow, 3).Value = "Trùng lap"
LastRow = LastRow + 1
' T?t c?p nh?t màn hình
Application.ScreenUpdating = False
' G?i hàm tìm ki?m file trùng l?p
Call SearchFolder(FolderPath, FileDict)
' T?o m?ng d? luu k?t qu?
Dim Results() As Variant
Dim resultCount As Long
resultCount = 0
' Xu?t k?t qu? ra m?ng
Dim FileHash As Variant
For Each FileHash In FileDict.Keys
If FileDict(FileHash).Count > 1 Then
Dim FilePath As Variant
For Each FilePath In FileDict(FileHash)
ReDim Preserve Results(1 To 3, 1 To resultCount + 1)
Results(1, resultCount + 1) = FilePath
Results(2, resultCount + 1) = FileHash
Results(3, resultCount + 1) = "Trùng lap"
resultCount = resultCount + 1
Next FilePath
End If
Next FileHash
' Ghi k?t qu? vào sheet
If resultCount > 0 Then
ws.Range(ws.Cells(LastRow, 1), ws.Cells(LastRow + resultCount - 1, 3)).Value = Application.Transpose(Results)
End If
' B?t l?i c?p nh?t màn hình
Application.ScreenUpdating = True
Debug.Print "Các file trùng l?p dã du?c ghi vào sheet."
End Sub
Private Sub SearchFolder(ByVal FolderPath As String, ByRef FileDict As Object)
Dim folder As Object
Dim subfolder As Object
Dim file As Object
' T?o FileSystemObject d? làm vi?c v?i thu m?c và file
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
' L?p qua các file trong thu m?c hi?n t?i
For Each file In fso.GetFolder(FolderPath).Files
Dim FileHash As String
FileHash = GetSHA1Hash(file.Path)
' N?u chua có hash trong dictionary, kh?i t?o m?t Collection m?i
If Not FileDict.Exists(FileHash) Then
FileDict.Add FileHash, New Collection
End If
' Thêm du?ng d?n file vào danh sách du?ng d?n c?a hash dó
FileDict(FileHash).Add file.Path
Next file
' L?p qua các thu m?c con
For Each subfolder In fso.GetFolder(FolderPath).SubFolders
Call SearchFolder(subfolder.Path, FileDict)
Next subfolder
End Sub
Sub RunDuplicateFileCheck()
Dim FolderPath As String
FolderPath = "D:\Database_Server" ' Thay d?i du?ng d?n t?i thu m?c b?n mu?n ki?m tra
'FolderPath = "D:\Delphi_Example_Library"
FindDuplicateFilesInFolder FolderPath
End Sub
