使用vba删除文件的旧版本

我在excel表格中列出了文件详细信息，如文件名、带目录的文件名、文件修改日期。 我想对硬盘上重复的文件进行排序，删除旧版本，保留新版本。 我编写了一段代码，删除列A中列出的所有dir name文件

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

单击此处查看embiggen

根据评论，问题是：

---

如何从[File Path]中的一组重复文件名中仅找到最新的[File Modified]日期，并删除所有其他日期？以下内容应满足您的要求，可能是最简单的方法。它已经被测试过，但是只有在有限的数据集上，所以你应该谨慎行事，并将其视为一个起点。 主要数据结构是具有文件名键的字典的数据结构。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

选项显式
函数newEntry（pa作为字符串，dt作为日期）作为集合
收藏
Set col=新集合
列添加pa的文件名路径
列添加dt的文件日期
设置newEntry=col
端函数
子RemoveOldDuplicates（）
Dim dict作为脚本。字典
Set dict=New Scripting.Dictionary
Dim pa作为字符串，fn作为字符串
Dim dt作为日期
变暗rng As范围，c As范围
设置rng=范围（“A1”，范围（“A”和行数）。结束（xlUp））
'填充/更新字典并删除重复文件
对于rng中的每个c
pa=c.值
fn=c.偏移量（0，1）
dt=CDate（c.偏移量（0,3））
如果dict.存在（fn），则
如果dt>dict（fn）（2），则
杀死dict（fn）（1）
Set dict（fn）=新条目（pa，dt）
其他的
杀死爸爸
如果结束
其他的
Set dict（fn）=新条目（pa，dt）
如果结束
下一个c
Dim top为整数，bot为整数，i为整数
bot=rng.单元格（1，1）.行
top=rng（rng.Count）。行
如果top=bot，则退出Sub
'删除字典中不存在的所有文件路径行
对于i=从上到下步骤-1：
集合c=单元（i，1）
fn=c.偏移量（0，1）
如果dict.存在（fn），则
如果dict（fn）（1）c.值，则
行（c.row）.EntireRow.Delete
如果结束
如果结束
接下来我
端接头

---

您可能会考虑向用户提供最新的文件和要删除的副本，然后询问他/她是否希望在不同的工作表上或使用UsRe表单来完成这项工作。至少这样，用户可以在执行永久删除之前检查是否有任何错误。

欢迎使用SO！您已经告诉了我们您的目标，并提供了非常棒的代码。你真的有问题吗？你的代码是非功能性的吗？您是否收到错误消息？请编辑你的帖子，详细说明你需要什么帮助。我有dir的文件名。我想先从'B'coulmn中排序重复的文件名，然后从重复列表中排序旧版本的文件名（最新版本可以从'D'coulmn中获得）并删除它们。我只是想把最新的文件放在机器上，不管它们在哪里。到目前为止，你们都试了什么？无需排序即可轻松完成，只需分两步使用

字典

。首先循环文件名/日期对，以便

如果dict.exists（文件名）存在，则比较日期，如果更新，则重写dict.add key:=文件名项：=日期

。在第二个循环中，删除所有未出现在dict中的内容。或者您正在寻找一位将为您编写该文档的人？好的，您已经发布了一些代码，并且两次（在您的OP和注释中）表示要删除重复的文件。你发布的代码就是这样做的吗？如果没有，它在哪里失败？您发布的代码没有解决的问题是什么？如果你不让那些试图帮助你猜出问题的人，你会更快地得到更好的答案。实际上，我想从“B”栏中考虑重复的文件，因为这些文件是我感兴趣的。然后转到“D”列根据日期排序->删除除最新版本之外的所有文件版本。我的代码是删除所有文件。我无法找出最新的文件来保存和删除旧的。很好，这就是我想要的。但我如何向用户显示“这些”文件将被删除。如果我们可以突出显示表中要删除的文件行，您可以编写代码吗？然后，我将为msg框添加代码，在删除文件之前确认用户。有多种方法可以做到这一点。最简单的方法可能是创建一个新的子例程，它类似于第一个for循环，但是您可以突出显示关联的行，而不是“终止”文件。您只需将行添加到集合中，即可将其保存在newEntry创建的集合中。如果您有问题，可以在此网站上创建另一个问题。一旦你有了这个子例程，你就可以使用以下过程：1）保存你的整个目录结构，可能是每天晚上的备份；2）运行上面提到的子例程，突出显示要删除的文件的工作表行（但不执行删除），3）运行后手动检查每个突出显示的行，以确保它没有删除不应该删除的内容，4）一旦满意，您可以运行RemoveOldDuplicates来执行所有删除操作。当然，您现在可以使用RemoveOldDuplicates-只需将您的文件/目录和主电子表格保存为备份，运行它，然后在两组文件（旧文件和新文件）之间进行检查，以查看它是否达到了预期效果。确定。我试试看。如果我在第一个子例程中使用1）条件格式，2）消息框用于确认，3）在上述第二个子例程中使用3）条件格式，也将是可行的