Hi John
Try below, please.
Option Explicit
Option Base 1
'----------------------------------------------------------
' Procedure : KeepNewestFile
' Date : 20060722
' Author : Joergen Bondesen
' Modifyed by :
' Purpose : Together with Function
' 'NewestFile(Directory, FileSpec)'
' to Kill all ExtentionArr in a
' specified folder(s) except latest
' modifyed, (not CREATED).
' Note : Att.: Modifyed, (not CREATED).
'----------------------------------------------------------
'
Sub KeepNewestFile()
Dim CommonPath As String
Dim ExtentionArr As Variant
Dim x As Long
CommonPath = "D:\_a Desktop\__Delete"
ExtentionArr = Array(Array("", "*.xls"), _
Array("\zip", "*.zip"))
For x = 1 To UBound(ExtentionArr)
MsgBox NewestFile(CommonPath & ExtentionArr(x)(1), _
ExtentionArr(x)(2))
Next x
End Sub
'----------------------------------------------------------
' Procedure : NewestFile
' Date : 20060722
' Author :
www.j-walk.com
' Modifyed by : Joergen Bondesen
' Purpose : Kill all FileSpec in a folder
' except latest modifyed, (not CREATED).
' Note : Att.: Modifyed, (not CREATED).
'----------------------------------------------------------
'
Function NewestFile(Directory, FileSpec)
' Returns the name of the most recent file in a Directory
' That matches the FileSpec (e.g., "*.xls").
' Returns an empty string if the directory does not exist or
' it contains no matching files
Dim FileName As String
Dim MostRecentFile As String
Dim MostRecentDate As Date
If Right(Directory, 1) < "\" Then Directory = _
Directory & "\"
FileName = Dir(Directory & FileSpec, 0)
If FileName < "" Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
Do While FileName < ""
If FileDateTime(Directory & FileName) _
MostRecentDate Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
End If
FileName = Dir
Loop
End If
NewestFile = MostRecentFile
'// kill
FileName = Dir(Directory & FileSpec, 0)
If FileName < "" Then
Do While FileName < ""
If FileName < NewestFile Then
Kill Directory & FileName
End If
FileName = Dir
Loop
End If
End Function
--
Best Regards
Joergen Bondesen
"JohnUK" wrote in message
...
Hi Mike,
Thank you for your help.
I like the way the dialogue box opens so that you can pick the folder, but
I
am afraid I need it to work without any intervention from the user apart
from
pressing a button.
Let me tell you in more detail what it is I am after:
I have a workbook that creates a zipped copy of itself (Windows Zip)as it
closes down and saves to 'Backup' Folder in 'My Documents' (Date and Time
tagged)for Backup purposes. Example: Backup Thu 20 Jul 14 51 26.zip
I also have another function that backs up my Main Page data to an excel
file and saves as date and time into a different Backup file (Main Page
Backups) Example: Main Page Backup Thu 20 Jul 14 51 26.xls
As you can imagine I can end up with lots of backups.
I then need at a touch of a button a piece of code that goes to Backup
Folder within My Documents, deletes all the Zipped files apart from the
latest date and time, then goes into Main Page Backups folder to delete
all
the excel files apart from the latest date and time.
I came across this piece of code from Ron De Bruin:
Kill "C:\TestFolder\*.xls"
But obviously it deletes all files which I don't want.
Regards
John
"crazybass2" wrote:
John,
NOTE: be very cautious when doing something like this. The file deleted
will not end up in the recycle bin.
I used the Excel standard for the first day of Jan 1, 1980. If your
files
are earlier than that you may need to redefine dummydate. I used the
Workbook_Open event to allow the user to select a folder location, but
you
may move all the code to one standard module procedure if you like.
In the ThisWorkbook Module put:
Private Sub Workbook_Open()
Dim foldername As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
foldername = .SelectedItems(1)
End With
ShowFolderList (foldername)
End Sub
AND in a standard module put:
Sub ShowFolderList(folderspec)
Dim fs, f1
Dim dummydate As Date
dummydate = "1/1/1980"
Set fs =
CreateObject("Scripting.FileSystemObject").GetFold er(folderspec).Files
For Each f1 In fs
If DateDiff("s", f1.datelastmodified, dummydate) < 0 Then
dummydate = f1.datelastmodified
Else: f1.Delete
End If
Next
For Each f1 In fs
If DateDiff("s", f1.datelastmodified, dummydate) 0 Then f1.Delete
Next
End Sub
Mike
"JohnUK" wrote:
Hi All,
I am after a piece of code that deletes all files within a folder with
the
exception of the latest file created.
Again any help greatly appreciated
John