Zugriff VBA alphabetisch Sortieren von Dateinamen mit Buchstaben des Alphabets

Question

Ich habe eine Dateistruktur, wo doppelte Dateien mit Buchstaben des Alphabets angehängt sind. Wenn beispielsweise Datei.txt bereits vorhanden ist, wird Datei-A.txt erstellt.

Ich muss die Liste aller Dateien eines bestimmten Namens in ein Array laden und so sortieren, dass Arr (25) der alphabetisch letzte Dateiname ist (IE Arr (25) = File-Z.txt) und ich habe die folgenden Sortieralgorithmus, aber es alphabetisiert immer so, dass File.txt das letzte Element in dem Array ist.

If filepath <> "" Then 
    Do Until filepath = "" 
     myArray(i) = filepath 
     filepath = Dir 
     i = i + 1 
    Loop 
End If 

'Alphabetize 
    For x = LBound(myArray) To UBound(myArray) 
    For y = x To UBound(myArray) 
     If UCase(myArray(y)) < UCase(myArray(x)) Then 
     TempTxt1 = myArray(x) 
     TempTxt2 = myArray(y) 
     myArray(x) = TempTxt2 
     myArray(y) = TempTxt1 
     End If 
    Next y 
    Next x 

Wie verhindere ich das?

Answer 1

Das Problem ist, dass Sie den vollständigen Dateinamen vergleichen. Der Grund file.txt sortiert vor file-a.txt ist, weil es Zeichen für Zeichen überprüft und beendet, sobald es einen ASCII-Wert in der ersten Datei findet, die höher als der entsprechende ASCII-Wert in der zweiten Datei ist. Ich dieser spezielle Fall, file.txt < file-a.txt kehrt False sobald es Position vergleicht 5 weil . ASCII 46 und - ist ASCII 45.

Unter der Annahme, dass Sie nur über .txt Dateien kümmern, ist die Lösung, die Dateien ohne die Erweiterungen zu vergleichen. Sie können entweder den Scripting.FileSystemObject, dies zu tun (was das Verzeichnis Lesen leichter machen würde) ...

'Add a reference to Microsoft Scripting Runtime 
With New Scripting.FileSystemObject 
    'Alphabetize 
    For x = LBound(myArray) To UBound(myArray) 
     For y = x To UBound(myArray) 
      If UCase$(.GetBaseName(myArray(y))) < UCase$(.GetBaseName(myArray(x))) Then 
       TempTxt1 = myArray(x) 
       TempTxt2 = myArray(y) 
       myArray(x) = TempTxt2 
       myArray(y) = TempTxt1 
      End If 
     Next y 
    Next x 
End With 

... oder können Sie verwenden Left$:

'Alphabetize 
For x = LBound(myArray) To UBound(myArray) 
    For y = x To UBound(myArray) 
     If UCase$(Left$(myArray(y), Len(myArray(y)) - 4)) < _ 
      UCase$(Left$(myArray(x), Len(myArray(x)) - 4)) Then 
      TempTxt1 = myArray(x) 
      TempTxt2 = myArray(y) 
      myArray(x) = TempTxt2 
      myArray(y) = TempTxt1 
     End If 
    Next y 
Next x