Sort folders by date

[JadeKnight]

I'm creating av sub in a script wich is going to do the following :

Connect to a folder, list subfolders, delete all subfolders above i(integer) keeping the newest folder(s).

Ex :

C:\Folder
C:\Folder\A - 01.01.2005
C:\Folder\B - 01.02.2005
C:\Folder\C - 01.03.2005
C:\Folder\D - 01.04.2005

With a call to sub "KeepOnly("C:\Folder", 2)" the remaining folders should be :

C:\Folder\C - 01.03.2005
C:\Folder\D - 01.04.2005

I'm having trouble figuring out how to do this. When I loop the folder with fso.subfolders and use DateCreated, it seems like the sortorder is based upon folder name.

I had an ida to put a sorted result into an array, and delete folders based upon this.

Any help, or other good ideas would be appreciated

 

[Jerz]

Picking the most recent folders is the dillema, I don't see how an array would help, the data would still be sorted by folder name. Any chance of creating the folder with the DateCreated embedded in the folder name somewhere?

 

[PHV]

Something like this ?

Sub KeepOnly(strDir, intKeep)
Dim fso, f, a(), sf, i, j, p, d
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(strDir)
If f.SubFolders.Count <= intKeep Then Exit Sub
ReDim a(1, f.SubFolders.Count - 1)
For Each sf In f.SubFolders
  a(0, i) = sf.Path
  a(1, i) = sf.DateCreated
  i = i + 1
Next
For i = 0 To UBound(a, 2) - 1
  For j = i + 1 To UBound(a, 2)
    If a(1, i) < a(1, j) Then
      p = a(0, j): d = a(1, j)
      a(0, j) = a(0, i): a(1, j) = a(1, i)
      a(0, i) = p: a(1, i) = d
    End If
  Next
Next
For i = intKeep To UBound(a, 2)
  fso.DeleteFolder a(0, i), True
Next
End Sub

And then somewhere in your script:
Call KeepOnly("C:\Folder", 2)

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[JadeKnight]

Thx for reply PHV, unfortunately this forum was inaccessible to me for a while, and I'm an impatient person... The stuff I came up with is similar to what you have provided. I used the "bubble sort". I used a sample from Michael Harris :

http://groups.google.co.uk/group/microsoft.public.scripting.vbscript/msg/e100dfd7068f55d

Anyway, here's what I came up with :

Sub s_KeepOnly(s, i)
	
	'On Error Resume Next
	
	Dim aDate
	Dim oFldr,oSubFldr
	Dim cFldr
	Dim iCnt
	Dim n,m,temp
	
	Set oFldr = oFso.GetFolder(s)
	Set cFldr = oFldr.SubFolders
	
	'Check if number of folders greater than i
	If oFldr.SubFolders.Count <= i Then
		Exit Sub
	End If

	'ReDim array to number of folders
	ReDim aDate(oFldr.SubFolders.Count -1)
	
	iCnt = 0
	
	'Add date creation of all folders to array
	For Each oSubFldr in cFldr
		aDate(iCnt) = oSubFldr.DateCreated
		iCnt = iCnt + 1
	Next
	
	'Sorting array by date, ascent sort order (The famous bubble sort)
		For n = 0 to UBound(aDate) -1 
		For m = n+1 to UBound(aDate) 
			If aDate(m) < aDate(n) Then
				temp = aDate(m)
				aDate(m) = aDate(n)
				aDate(n) = temp
			End If
		Next
	Next
	
	'Cut array, keep (i) rows with date of folders wich is going to be deleted
	ReDim Preserve aDate(UBound(aDate) -i)
	
	For Each oSubFldr in cFldr
		For iCnt = 0 To UBound(aDate)
			If oSubFldr.DateCreated = aDate(iCnt) Then
				s_DeleteFolder oSubFldr.Path
				Exit For
			End If
		Next
	Next
End Sub

Code Explained :

Connects to root of folder (s) and count subfolders, if count of subfolders is greater than i, then it put datecreated on every folder within root into an array. Then the array gets sorted by ascent. After sort, a ReDim occur, and cut away every date wich should be kept. Then loop through every folder checking array with date, if match folder is deletet in sub s_DeteFolder(s) (not provided here)