AW: Verzeichniseinträge der Größe nach sortieren
17.01.2005 18:08:14
Timo
Hmmmh,
sieht irgendwie nicht ganz nachdem aus wie ich es haben wollte. Ich habe es inzwischen aber gelöst, ohne Worksheets - nur mittels den üblichen Dateifunktionen und einem Quicksort Algorithmus von http://vbnet.mvps.org/index.html?code/sort/qsoverview.htm , mußte Ihn nur noch auf meine Klasse FileInfo (damit nach der Größe geordnet wird) anpassen. Die Klasse FileInfo speichert lediglich die notwendigen Attribute einer Datei (Dateigröße, Dateiname) und hat keine Methoden.
Trotzdem vielen Dank!
Viele Grüße,
Timo
***Auszug aus dem Listing
.
.
.
Dim fiDirScan As FileInfo
Dim fileSearch As Object
Dim infileCount As Long
Dim inCount As Integer
Dim fiArray() As FileInfo
Dim stActual As String
Dim fs, f As Object
'Schaue wieviel Dateien im Verzeichnis sind
Set fileSearch = Application.fileSearch
With fileSearch
.LookIn = stPathName
.Filename = "*.doc"
.Execute
infileCount = .FoundFiles.count
End With
'Array mit Anzahl der Dateien im Verzeichnis erzeugen
ReDim fiArray(infileCount - 1)
inCount = 0
stActual = Dir$(stPathName & "\*.doc") 'Alle Worddateien im Verzweichnis
Do While stActual "" 'durchsuchen
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(stPathName & "\" & stActual)
Set fiArray(inCount) = New FileInfo
fiArray(inCount).strFileName = stActual 'Dateiname und
fiArray(inCount).lngFileSize = f.Size 'Größe im Array abspeichern
inCount = inCount + 1
stActual = Dir$()
Loop
'Sortieren per Quicksort nach Dateigröße
QuickSortFileInfo fiArray, 0, infileCount - 1
'Nun haben wir den Array der Größe nach sortiert
.
.
.
***Quicksortalgorithmus
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2005 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Source http://vbnet.mvps.org/index.html?code/sort/qsoverview.htm
'
' Modified 2005 by Timo Steuerwald
Public
Sub QuickSortFileInfo(vArray() As FileInfo, inLow As Long, inHi As Long)
'vArray() The array to sort
'inLow Lower bound of sort point
'inHi Upper bound of sort point
'Dim two working variables to hold
'array members. The first holds the
'pivot item - the item half way between
'the inLow and inHi values, while the
'second is used to hold the array contents
'that will be swapped later.
'These two items should be declared as
'the same data type as the array passed.
Dim pivot As FileInfo
Dim tmpSwap As FileInfo
'Dim two working variables to hold the
'values representing the pivot's lower
'and upper points as passed to the routine.
'These should be declared as the same data
'type as the inLow/inHi variables passed.
Dim tmpLow As Long
Dim tmpHi As Long
'Save to the working variables the
'values passed as lower & upper
tmpLow = inLow
tmpHi = inHi
'Get the item halfway through the data
'determined by the range passed as lower
'and upper and assign it as the pivot data
'When first calling this routine the
'range is inLow = LBound(array), and
'inHi = UBound(array). During subsequent
'calls, inLow and inHi will receive
'different values as determined below.
Set pivot = vArray((inLow + inHi) \ 2)
'With pivot holding the value of the item
'halfway through the range, compare the
'rank of tmpLow to tmpHi and assign the two
'tmp storage variables that data for later
'comparison. Here we're continuing the loop
'while the low item being compared value (tmpLow)
'is less than tmpHi (the upper bound value).
While (tmpLow <= tmpHi)
'Since (and while) tmpLow remains less than
'tmpHi, compare the value of the array()
'element at this position against pivot.
While ((vArray(tmpLow).lngFileSize < pivot.lngFileSize) And tmpLow < inHi)
tmpLow = tmpLow + 1
Wend
'repeat the same for the array value at
'position tmpHi.
While (pivot.lngFileSize < vArray(tmpHi).lngFileSize And tmpHi > inLow)
tmpHi = tmpHi - 1
Wend
'When the position of tmpHi exceeds or matches tmpLow
'swap the two items.
If (tmpLow <= tmpHi) Then
'a: assign vArray(tmpLow) to tmpSwap
'b: swap vArray(tmpHi) for vArray(tmpLow)
'c: assign tmpSwap back to vArray(tmpHi)
Set tmpSwap = vArray(tmpLow)
Set vArray(tmpLow) = vArray(tmpHi)
Set vArray(tmpHi) = tmpSwap
'adjust the new Hi and Low values
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Wend
'if the original lower is less than tmpHi,
'call the routine again with inLow & tmpHi
'as the pivot's lower and upper points.
If (inLow < tmpHi) Then QuickSortFileInfo vArray, inLow, tmpHi
'if the new tmpLow value lower is less than
'the original inHi, call the routine again with
'tmpLow & inHi as the pivot's lower and upper points.
If (tmpLow < inHi) Then QuickSortFileInfo vArray, tmpLow, inHi
End Sub