VBA xóa Ảnh- Video bị trùng lặp

[barney1]

Em có folder (khoảng 40GB) có nhiều ảnh, video tên bị trùng lặp nên giờ muốn viết 1 VBA để xóa các ảnh, video có đuôi trùng lặp.
Các file trùng lặp có tên theo thời gian như thế này
Ảnh gốc( * là đuôi ảnh .jpg, heic, jpeg, mov...)
2023-05-13 111755.*
2019-12-17 010326.*
Ảnh sau khi copy
2023-05-13 111755.*
2023-05-13 111755(1).*

2019-12-17 010326.*
2019-12-17 010326(1).*
2019-12-17 010326(2).*
2019-12-17 010326(3).*
2019-12-17 010326(4)...
Nhờ các bác viết 1 VBA để xóa các ảnh, video bị copy trùng lặp với ạ

 

[htin1997]

Em nhớ không nhầm là trên diễn đàn đã có người chia sẽ cả python nữa bác, dùng thuật toán xoá ảnh tương tự luôn chứ không đơn giản là tên file.

đuôi trùng lặp

Còn phần xoá đuôi trùng lặp là sao? Em hiểu là phần mở rộng, nếu xoá đuôi trùng lặp thì giữ mỗi loại 1 file hay sao bác?
Còn nếu xoá file có tên giống nhau nhưng có thêm (1), (2),... thì file nào cần xoá, file nào giữ?

 

[BuiQuangThuan]

Tìm tool của anh @befaint. Có lẽ tool của anh ấy thừa ứng dụng cho nhu cầu của bạn ấy

 

[HeSanbi]

@barney1 bạn sử dụng ứng dụng Excel đơn giản dưới đây
Chọn thư mục, tệp chứa nhập: *(*)* và, lấy danh sách.
Sau đó bạn muốn xóa, chọn tệp cần xóa nhấn Xóa tệp chọn

ExplorerXL - Quản lý thư mục với Excel: tìm, đổi tên, sao chép, di chuyển và xóa

Hôm nay, tôi chia sẻ với các bạn ứng dụng quản lý thư mục và tập tin được viết dựa trên bảng tính Excel và VBA, ứng dụng giúp dễ dàng tìm kiếm thư mục và tập tin, cũng như đổi tên, sao chép, di chuyển đến thư mục khác hoặc xóa tập tin rất linh hoạt. Hình ảnh ứng dụng: File ứng dụng: (***Mật...

www.giaiphapexcel.com

 

[soros20102020]

đoạn code của bạn đây, hy vọng nó work ;-)

Sub XoaFileTrungLap()
Dim folderPath As String
Dim filesDict As Object
Dim file As Variant
Dim fileName As String
Dim fileExtension As String
Dim baseFileName As String
Dim count As Integer

' Đặt đường dẫn đến thư mục chứa các ảnh và video
folderPath = "Đường dẫn đến thư mục của bạn"

' Tạo một đối tượng từ Scripting.Dictionary để lưu trữ các tên file gốc
Set filesDict = CreateObject("Scripting.Dictionary")

' Lặp qua tất cả các file trong thư mục
For Each file In VBA.FileSystem.Dir(folderPath & "\*")
' Lấy tên file và đuôi file
fileName = VBA.FileSystem.GetBaseName(file)
fileExtension = VBA.FileSystem.GetExtensionName(file)

' Kiểm tra nếu file có đuôi là .jpg, .heic, .jpeg, .mov (có thể chỉnh sửa theo nhu cầu của bạn)
If fileExtension = "jpg" Or fileExtension = "heic" Or fileExtension = "jpeg" Or fileExtension = "mov" Then
' Tách tên file gốc và số thứ tự
baseFileName = VBA.Left(fileName, Len(fileName) - Len(VBA.Right(fileName, Len(fileName) - InStrRev(fileName, "("))))

' Kiểm tra xem tên file gốc đã tồn tại trong filesDict chưa
If Not filesDict.Exists(baseFileName) Then
' Nếu tên file gốc chưa tồn tại, thêm nó vào filesDict
filesDict.Add baseFileName, 1
Else
' Nếu tên file gốc đã tồn tại, tăng đếm số lượng trùng lặp
count = filesDict(baseFileName) + 1
filesDict(baseFileName) = count

' Xóa file bị copy trùng lặp
VBA.FileSystem.Kill folderPath & "\" & fileName & "." & fileExtension
End If
End If
Next file

' Hiển thị thông báo về số lượng file đã bị xóa
MsgBox "da xoa " & filesDict.Count & " file copy bi trung lap", vbInformation
End Sub

 

[barney1]

Em nhớ không nhầm là trên diễn đàn đã có người chia sẽ cả python nữa bác, dùng thuật toán xoá ảnh tương tự luôn chứ không đơn giản là tên file.

Còn phần xoá đuôi trùng lặp là sao? Em hiểu là phần mở rộng, nếu xoá đuôi trùng lặp thì giữ mỗi loại 1 file hay sao bác?
Còn nếu xoá file có tên giống nhau nhưng có thêm (1), (2),... thì file nào cần xoá, file nào giữ?

(1), (2),. các file có đuôi sẽ xóa ạ

 

[barney1]

đoạn code của bạn đây, hy vọng nó work ;-)

Sub XoaFileTrungLap()
Dim folderPath As String
Dim filesDict As Object
Dim file As Variant
Dim fileName As String
Dim fileExtension As String
Dim baseFileName As String
Dim count As Integer

' Đặt đường dẫn đến thư mục chứa các ảnh và video
folderPath = "Đường dẫn đến thư mục của bạn"

' Tạo một đối tượng từ Scripting.Dictionary để lưu trữ các tên file gốc
Set filesDict = CreateObject("Scripting.Dictionary")

' Lặp qua tất cả các file trong thư mục
For Each file In VBA.FileSystem.Dir(folderPath & "\*")
' Lấy tên file và đuôi file
fileName = VBA.FileSystem.GetBaseName(file)
fileExtension = VBA.FileSystem.GetExtensionName(file)

' Kiểm tra nếu file có đuôi là .jpg, .heic, .jpeg, .mov (có thể chỉnh sửa theo nhu cầu của bạn)
If fileExtension = "jpg" Or fileExtension = "heic" Or fileExtension = "jpeg" Or fileExtension = "mov" Then
' Tách tên file gốc và số thứ tự
baseFileName = VBA.Left(fileName, Len(fileName) - Len(VBA.Right(fileName, Len(fileName) - InStrRev(fileName, "("))))

' Kiểm tra xem tên file gốc đã tồn tại trong filesDict chưa
If Not filesDict.Exists(baseFileName) Then
' Nếu tên file gốc chưa tồn tại, thêm nó vào filesDict
filesDict.Add baseFileName, 1
Else
' Nếu tên file gốc đã tồn tại, tăng đếm số lượng trùng lặp
count = filesDict(baseFileName) + 1
filesDict(baseFileName) = count

' Xóa file bị copy trùng lặp
VBA.FileSystem.Kill folderPath & "\" & fileName & "." & fileExtension
End If
End If
Next file

' Hiển thị thông báo về số lượng file đã bị xóa
MsgBox "da xoa " & filesDict.Count & " file copy bi trung lap", vbInformation
End Sub

Code này không chạy được như ý bác ạ

 

[htin1997]

Chọn thư mục, tệp chứa nhập: *(*)* và, lấy danh sách.

Em cũng nghĩ vậy và vào test thử thì nó lại không lọc được. Hay là thằng Explorer của em có vấn đề?

 

[Maika8008]

Chỉ đơn giản là xóa các file mà tên của nó có dấu ngoặc ( phải không nhỉ?

 

[barney1]

Chỉ đơn giản là xóa các file mà tên của nó có dấu ngoặc ( phải không nhỉ?

Vâng đúng, về cơ bản là xóa các file mà tên có dấu ngoặc ( , đó bác

 

[anhdepjai]

Trước mình có làm cái này, chắc là bạn chỉnh 1 chút là xài được

 

[tieutuvodanh192]

Nếu chạy ở máy cá nhân thì File Python của anh befaint ở link dưới sẽ hữu ích với bạn.
Mình đã từng chạy file Python bên dưới ở máy công ty và đã bị bên bộ phận IT gõ đầu, đại loại là phần mềm này mã hóa file, hệ thống phát hiện và cảnh báo đỏ với máy của mình, họ giải thích vậy. Tất nhiên đó chỉ là cảnh báo, lưu ý nhỏ tới bạn.

[ Python và ứng dụng ] Phần mềm tìm và xóa Files trùng lặp tốc độ siêu#

[ Python và ứng dụng ] Phần mềm tìm và xóa Files trùng lặp tốc độ siêu# Phầm mềm được viết bằng Python. Tìm và liệt kê tất cả các thể loại Files có trong Folder được chọn mà có nội dung giống nhau. Kết quả tìm kiếm được ghi ra tập tin Duplicate Files.log. Đường dẫn File đầu tiên mà trùng với...

www.giaiphapexcel.com

 

[befaint]

đại loại là phần mềm này mã hóa file

Phần mềm không mã hóa gì cả. Trong mã có lệnh xóa tập tin thì hệ thống tường lửa cảnh báo là đương nhiên. Không cảnh báo mới dở.