Do more with
Sub KillEm()
Dim MyPath As String, objFile
Dim objDic As Object
Dim txtMarker
Set objDic = CreateObject("scripting.dictionary")
MyPath = "c:\"
objFile = Dir(MyPath & "\*.*")
Do While Len(objFile) <> 0
txtMarker = InStr(objFile, "_")
If txtMarker > 0 Then
If objDic.exists(Left$(objFile, txtMarker - 1) & Right$(objFile, 4)) Then
If ConDate(Mid$(objFile, txtMarker + 1, 8)) > ConDate(objDic(Left$(objFile, txtMarker - 1) & Right$(objFile, 4))) Then
Kill MyPath & "\" & Left$(objFile, txtMarker) & objDic(Left$(objFile, txtMarker - 1) & Right$(objFile, 4)) & Right$(objFile, 4)
objDic(Left$(objFile, txtMarker - 1) & Right$(objFile, 4)) = Mid$(objFile, txtMarker + 1, 8)
Else
Kill MyPath & "\" & objFile
End If
Else
objDic.Add Left$(objFile, txtMarker - 1) & Right$(objFile, 4), Mid$(objFile, txtMarker + 1, 8)
End If
End If
objFile = Dir
Loop
End Sub
Function ConDate(anyStr) As Date
ConDate = DateSerial(Right$(anyStr, 4), Left$(anyStr, 2), Mid$(anyStr, 3, 2))
End Function
Premium Content
You need an Expert Office subscription to comment.Start Free Trial