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

  • 質問

  • 以下のようなソースで,自分自身のいるフォルダ以下の最下層サブフォルダ名をテキストファイルに吐き出す
    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

     

     

    2008年4月17日 2:34

すべての返信

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

     

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

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

    2008年4月17日 6:20
  • レゲレゲ様,返信有り難うございました。

     

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

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

    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
    2008年4月17日 7:21