我有excel表中列出的文件详细信息,如文件名,文件名和dir,文件修改日期。 我想在我的硬盘驱动器上对重复的文件进行排序,并删除旧版本,保留更新的版本。 我编写的代码用dir名称删除了列A中列出的所有文件。
Sub DeleteExample3()
Dim c As Range, f As String
For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
f = c.Value2 & c.Offset(0, 1).Value2
Kill f
Next c
On Error GoTo 0
End Sub
根据评论,问题是:
如何从[文件路径]中找到一组重复文件名中的最新[文件修改]日期并删除所有其余日期?
答案 0 :(得分:0)
以下应该做你想要的,也许是完成它的最简单的方法。它已经过测试,但仅限于有限的数据集,因此您应该谨慎行事并将其作为起点。
主数据结构是具有文件名密钥的字典。 newEntry函数创建的值是两个元素集合,其元素是文件的完整路径名和文件日期/时间。
处理发生在两个循环中,第一个循环填充字典并删除具有较早时间/日期的所有重复文件。第二个从电子表格中删除旧版重复项的行。
请注意,仅删除较旧的重复文件。目录未被修改。
Option Explicit
Function newEntry(pa As String, dt As Date) As Collection
Dim col As Collection
Set col = New Collection
col.Add pa 'filename path
col.Add dt 'file date
Set newEntry = col
End Function
Sub RemoveOldDuplicates()
Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary
Dim pa As String, fn As String
Dim dt As Date
Dim rng As Range, c As Range
Set rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
' populate/update dictionary and delete duplicate files
For Each c In rng
pa = c.Value
fn = c.Offset(0, 1)
dt = CDate(c.Offset(0, 3))
If dict.exists(fn) Then
If dt > dict(fn)(2) Then
Kill dict(fn)(1)
Set dict(fn) = newEntry(pa, dt)
Else
Kill pa
End If
Else
Set dict(fn) = newEntry(pa, dt)
End If
Next c
Dim top As Integer, bot As Integer, i As Integer
bot = rng.Cells(1, 1).row
top = rng(rng.Count).row
If top = bot Then Exit Sub
' Remove all rows of file paths that aren't in dictionary
For i = top To bot Step -1:
Set c = Cells(i, 1)
fn = c.Offset(0, 1)
If dict.exists(fn) Then
If dict(fn)(1) <> c.Value Then
Rows(c.row).EntireRow.Delete
End If
End If
Next i
End Sub
您可能会考虑做的是向用户显示最新文件和要删除的副本,然后询问他/她是否要在不同的工作表或用户表单上执行此操作。至少在这种情况下,用户可以在执行永久删除之前检查是否有任何错误。