XP以降のエクスプローラと同じソートをする方法はないでしょうか？

Question

以下のようなソースで，自分自身のいるフォルダ以下の最下層サブフォルダ名をテキストファイルに吐き出す
VBScriptアプリケーションを作製したのですが，
ソート時に文字列の単純比較をしているので
XP以降のエクスプローラと同じ順番にソートされません。
XP以降のエクスプローラと同じソートをする方法はないでしょうか。
（地道に数字を検出してソートするしかないのでしょうか？）

#VBScriptですが，2～3行目を消せばVB6上でも問題なく動作したのでこのフォーラムで質問させていただいています。

#もっと適切なフォーラムなどありましたら誘導していただいても結構です。結果はこちらにも書き込みます。

Code Snippet

Option Explicit
Call main
WScript.Quit (0)        '終了

 

Sub main()
    Dim objFSO
    Dim objTXF
    Dim strPath
    Dim strAll()
    Dim strTemp
    Dim cnt
    Dim i, j
   
    strPath = "."
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Call GetPath(objFSO, strPath, strAll, cnt)
    cnt = cnt - 1
   
    'Sort
    For i = 0 To cnt
        For j = i To cnt
            If strAll(i) > strAll(j) Then
                strTemp = strAll(i)
                strAll(i) = strAll(j)
                strAll(j) = strTemp
            End If
        Next
    Next
   
    'Output
    Set objTXF = objFSO.CreateTextFile(".\ListFolder.txt")
    For i = 0 To cnt
        objTXF.WriteLine strAll(i)
    Next
    objTXF.Close

End Sub

Sub GetPath(objFSO, strPath, strAll, cnt)
   
    Dim FolderObject
    Dim objList
   
    Set FolderObject = objFSO.GetFolder(strPath)
    If FolderObject.SubFolders.Count = 0 Then
        ReDim Preserve strAll(cnt)
        strAll(cnt) = strPath
        cnt = cnt + 1
    Else
        For Each objList In FolderObject.SubFolders
            Call GetPath(objFSO, objList.Path, strAll, cnt)
        Next
    End If

End Sub

 

 

Answer 1

検索されたほうが早いかもしれません。

 

ファイル名をエクスプローラと同じ順序にソートする。

このサイトにサンプルコードも載っていますので確認してみてください。

Answer 2

レゲレゲ様，返信有り難うございました。

 

リンクを辿って，早速試してみました。最初のフォルダ名の取得をカレントフォルダを取得するようアレンジしてあります。

また，出力先はコマンドプロンプトでなくテキストファイルにするようアレンジしてあります。

Code Snippet

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolderObject = objFSO.GetFolder(".")
FolderName = objFolderObject.Path
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate FolderName
Do While ie.Busy Or ie.ReadyState <> 4
    WScript.Sleep 100
Loop
Set objTXF = objFSO.CreateTextFile(".\ListFolderIE.txt")
Set Folder = ie.Document.Folder
For Each FolderItem In Folder.Items()
    objTXF.WriteLine FolderItem.Name
Next
objTXF.Close
ie.Quit

6行目でエラーが出ます。

IEが立ち上がってないとき：「リモートサーバマシンが存在しないか、利用できません。 : 'ie.Busy'」

IEが立ち上がっているとき：「起動されたオブジェクトはクライアントから切断されました。」

元のコードのようにFolderName の値を決め打ちにしても同じ状況です。

なお，私のPCに入っているIEのバージョンは7.0.5730.11です。元になったコードはIEのバージョンに関して記述がないですね。

 

#VBScriptですが，このままここで質問し続けても良いのでしょうか……？

#もしどなたか解決策を返信していただければ幸いです。

 

 

 

--おまけ------------------------------------------------------------------------------------------------------------------------------------------

VB6ではWin32APIのStrCmpLogicalWが使えるようです。

Code Snippet

Declare Function StrCmpLogicalW Lib "SHLWAPI.DLL" (ByVal lpStr1 As String, ByVal lpStr2 As String) As Long

StrCmpLogicalW(StrConv(str1, vbUnicode), StrConv(str2, vbUnicode))の戻り値は

str1>str2の時は1

str1=str2の時は0

str1<str2の時は-1

のようです。

#文字列はUnicodeで比較しなくてはならないのでStrConvを使います。

#以下サンプルソース(VB6.0専用ということで型宣言を追加しています。)

Code Snippet

Option Explicit
Declare Function StrCmpLogicalW Lib "SHLWAPI.DLL" (ByVal lpStr1 As String, ByVal lpStr2 As String) As Long

Sub main()
    Dim objFSO As Object
    Dim objTXF As Object
    Dim strPath As String
    Dim strAll() As String
    Dim strTemp As String
    Dim cnt As Long
    Dim i As Long
    Dim j As Long
   
    strPath = "."
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Call GetPath(objFSO, strPath, strAll, cnt)
    cnt = cnt - 1
   
    'Sort

    For i = 0 To cnt
        For j = i To cnt
            If StrCmpLogicalW(StrConv(strAll(i), vbUnicode), StrConv(strAll(j), vbUnicode)) > 0 Then
                strTemp = strAll(i)
                strAll(i) = strAll(j)
                strAll(j) = strTemp
            End If
        Next
    Next
        
    'Output

    Set objTXF = objFSO.CreateTextFile(".\ListFolder.txt")
    For i = 0 To cnt
        objTXF.WriteLine strAll(i)
    Next
    objTXF.Close

End Sub

 

Sub GetPath(objFSO As Object, strPath As String, strAll() As String, cnt As Long)
   
    Dim FolderObject As Object
    Dim objList As Object
   
    Set FolderObject = objFSO.GetFolder(strPath)
    If FolderObject.SubFolders.Count = 0 Then
        ReDim Preserve strAll(cnt)
        strAll(cnt) = strPath
        cnt = cnt + 1
    Else
        For Each objList In FolderObject.SubFolders
            Call GetPath(objFSO, objList.Path, strAll, cnt)
        Next
    End If

End Sub

 

#フルパスを直接比較してもちゃんとフォルダ名の区切り("\")を考慮した比較が行われるようです。

#以下，上記ソースの実行例。（テストのために指揮者名(Giulini,Eichhorn,Blomstedt)の前に数字を入れてみました。）

F:\Wave\Bruckner\2Giulini\Symphony No.7 VPO
F:\Wave\Bruckner\2Giulini\Symphony No.8 VPO
F:\Wave\Bruckner\2Giulini\Symphony No.9 VPO
F:\Wave\Bruckner\05Eichhorn\Symphony No.9 BOL
F:\Wave\Bruckner\11Blomstedt\Symphony No.7 LGO 2006
F:\Wave\Bruckner\11Blomstedt\Symphony No.8 LGO 2005