PDA

View Full Version : Solved: vba dir() need sorting by filename



beerli
03-12-2010, 12:52 AM
FNames = Dir("order*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

How to get FNames sorted?

mdmackillop
03-13-2010, 11:33 AM
Option Explicit
Sub Testing()
Dim FNames As String
Dim arr()
Dim i As Long, j As Long

ReDim arr(1000) 'set greater than possible number of files
FNames = Dir("C:\*.xls") 'set your own path
Do Until FNames = ""
arr(i) = FNames
i = i + 1
FNames = Dir
Loop
ReDim Preserve arr(i)
QuickSort arr(), LBound(arr), UBound(arr)
For j = 0 To i
Cells(j + 1, 2) = arr(j)
Next

End Sub


Private Sub QuickSort(strArray(), intBottom As Integer, intTop As Integer)
Dim strPivot As String, strTemp As String
Dim intBottomTemp As Integer, intTopTemp As Integer
intBottomTemp = intBottom
intTopTemp = intTop
strPivot = strArray((intBottom + intTop) \ 2)
While (intBottomTemp <= intTopTemp)
While (strArray(intBottomTemp) < strPivot And intBottomTemp < intTop)
intBottomTemp = intBottomTemp + 1
Wend
While (strPivot < strArray(intTopTemp) And intTopTemp > intBottom)
intTopTemp = intTopTemp - 1
Wend
If intBottomTemp < intTopTemp Then
strTemp = strArray(intBottomTemp)
strArray(intBottomTemp) = strArray(intTopTemp)
strArray(intTopTemp) = strTemp
End If
If intBottomTemp <= intTopTemp Then
intBottomTemp = intBottomTemp + 1
intTopTemp = intTopTemp - 1
End If
Wend
'the function calls itself until everything is in good order
If (intBottom < intTopTemp) Then QuickSort strArray, intBottom, intTopTemp
If (intBottomTemp < intTop) Then QuickSort strArray, intBottomTemp, intTop
End Sub