Re: VB6 Directory\File Maintenance

From: Ken Halter (Ken_Halter_at_Use_Sparingly_Hotmail.com)
Date: 12/02/04 

Date: Thu, 2 Dec 2004 12:23:11 -0800

"John Walker" <JohnWalker@discussions.microsoft.com> wrote in message
news:87423B59-723C-470E-904A-776389C2E917@microsoft.com...
> the DIR function, but I can't figure out how to make sure that the 3 files
> to
> be retained are the most recent. I know how to delete files, but don't
> know
> how to 'order' by date. Does anyone have a suggestion as to how I should
> go
> about this? And if sample code is available, that would be great.

Here's one way (no FSO). Needs a command button to start the process.
'=================
Option Explicit

Private Sub Command1_Click()
   Const THE_PATH = "D:\Temp\" 'needs trailing backslash
   Const THE_FILE_SPEC = "*.*"
   Call SearchAndDestroy(THE_PATH, THE_FILE_SPEC)
End Sub

Private Sub SearchAndDestroy(Path As String, FileSpec As String)
   Dim iFileCount As Integer
   Dim iArrayBounds As Integer
   Dim sCurrentFileName As String
   Dim dtCurrentFileDate As Date
   Dim sFullPath As String
   Dim dtFileDate() As Date
   Dim sFileNames() As String
   Dim bReSort As Boolean

   'Collect the files (this can be improved it there are tons of files)
   iArrayBounds = -1
   sCurrentFileName = Dir$(Path & FileSpec)
   Do While Len(sCurrentFileName) > 0
      iArrayBounds = iArrayBounds + 1
      sFullPath = Path & sCurrentFileName
      ReDim Preserve sFileNames(iArrayBounds)
      sFileNames(iArrayBounds) = sFullPath
      sCurrentFileName = Dir$
   Loop

   'Grab all dates
   ReDim dtFileDate(iArrayBounds)
   For iFileCount = 0 To iArrayBounds
      dtFileDate(iFileCount) = FileDateTime(sFileNames(iFileCount))
   Next

   'Sort the dates
   Do
      bReSort = False
      For iFileCount = 0 To iArrayBounds - 1
         If DateDiff("s", dtFileDate(iFileCount) _
            , dtFileDate(iFileCount + 1)) > 0 Then
            Call Swap(dtFileDate(iFileCount), dtFileDate(iFileCount + 1))
            Call Swap(sFileNames(iFileCount), sFileNames(iFileCount + 1))
            bReSort = True
         End If
      Next
   Loop While bReSort

   'Show the 3 newest files
   For iFileCount = 0 To 2
      Debug.Print sFileNames(iFileCount), dtFileDate(iFileCount)
      'Remove the comment mark below to kill the file
      'Kill sFileNames(iFileCount)
   Next

End Sub

Private Sub Swap(a As Variant, b As Variant)
   Dim c As Variant
   c = a
   a = b
   b = c
End Sub
'================= 

-- 
Ken Halter - MS-MVP-VB - http://www.vbsight.com
Please keep all discussions in the groups..