Auric__
7/16/2012 12:29:00 AM
scbs29 wrote:
> Can anyone advise me of a sort array for the following.
> I have files in a folder, the names of whic I pick up within my
> program using the Dir() function, eg
> Dim intFiles As Integer
> Dim strFile As String
> intFiles = 0
> strFile = Dir(strFolder)
> Do While strFile <> vbNullString
> If strFile <> "." And strFile <> ".." Then
> intFiles = intFiles + 1
> ReDim Preserve strFileNames(intFiles)
> strFileNames(intFiles - 1) = strFolder &
> strFile
> End If
> strFile = Dir
> Loop
>
> In explorer the filenames are listed as
[snip]
> but when I retrieve and display the filenames they are listed as
[snip]
> How can I sort these names so that they are in the same order as sjown
> in explorer ?
> I have tried a lot of sort algorithms I have found through DuckDuckGo
> but none of them do the job.
> Can anyone help ?
> Will I have to write my own sort algorithm ?
Short version: yes.
Long version: For pretty much all generic sorting algorithms, "10" < "2"
because the leftmost character of the strings are "1" and "2". With Windows
XP, Microsoft altered Explorer's sort algorithm to recognize numbers and
sort them appropriately, so it recognizes that "10" > "2". (Windows 2000
and older sort the way you don't want.)
To sort appropriately, your sorter would need to do something like this:
Sub custom_sorter(ByRef what() As String)
'variation of bubble sort
Dim L0 As Long, L1 As Long, f1 As Long, f2 As Long
Dim n1 As Double, n2 As Double, altered As Boolean
Do
altered = False
For L0 = LBound(what) To UBound(what) - 1
If what(L0) <> what(L0 + 1) Then
f1 = InStrAny(1, what(L0), "0123456789")
f2 = InStrAny(1, what(L0 + 1), "0123456789")
If f1 <> f2 Then
'numbers not in same position
If what(L0) > what(L0 + 1) Then
Swap what(L0), what(L0 + 1)
altered = True
End If
Else
'numbers in the same position;
'is the part before the numbers the same?
If Left(what(L0), f1 - 1) <> Left(what(L0 + 1), f1 - 1) Then
'left parts don't match; numbers don't matter
If what(L0) > what(L0 + 1) Then
Swap what(L0), what(L0 + 1)
altered = True
End If
Else
'text matches; numbers matter now
For L1 = f1 + 1 To Len(what(L0))
Select Case Mid(what(L0), L1, 1)
Case "0" To "9", "."
'do nothing
Case Else
n1 = Val(Mid(what(L0), f1, L1 - f1))
Exit For
End Select
Next
For L1 = f1 + 1 To Len(what(L0 + 1))
Select Case Mid(what(L0 + 1), L1, 1)
Case "0" To "9", "."
'do nothing
Case Else
n2 = Val(Mid(what(L0 + 1), f1, L1 - f1))
Exit For
End Select
Next
If n1 > n2 Then
Swap what(L0), what(L0 + 1)
altered = True
End If
End If
End If
End If
Next
Loop While altered
End Sub
'-----support functions-----
Function InStrAny(start As Integer, lookin As String, _
lookfor As String) As Long
Dim tmp1 As Long, L0 As Long
For L0 = start To Len(lookin)
tmp1 = InStr(lookfor, Mid$(lookin, L0, 1))
If tmp1 Then
InStrAny = L0
Exit Function
End If
Next
End Function
Sub Swap(ByRef var1, ByRef var2)
If VarType(var1) <> VarType(var2) Then Exit Sub
Dim tmp
tmp = var1
var1 = var2
var2 = tmp
End Sub
You're welcome to use the above in your project if you want, but you should
make sure it actually does what you want. (You should also note that bubble
sort is just about the slowest sort algorithm, and my code is slower than a
"normal" bubble sort.)
--
Hallo. My nem eez Inigo Montoya. You keel my father. Prepare to die.