VB6で絞込み検索を行なうには？ (ID:88731)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

じゃんぬねっとさんのサンプルソースを理解してれば、その応用で出来るはず
なんですが・・・。

こんな感じでしょうか。
勝手に改造しちゃいました(^^;
でも試してないのでうまくいかないかも

Public Function GetFoldersMostDeep(ByVal nRootPath As String, ByVal nPattern As String) As String()
    Dim lCopy         As Long
    Dim lIndex        As Long
    Dim lBounds       As Long
    Dim nReturns()    As String
    Dim nFilePathes() As String
    Dim hRootFolder   As Folder
    Dim hSubFolder    As Folder

' 0 の要素だけ確保しておく (Nothing が使えないため)
    ReDim nReturns(0)

' 検索文字列をすべて大文字にする (Like 演算子が大文字・小文字を区別するため)
    nPattern = StrConv(nPattern, vbUpperCase)

' FileSystemObject の新しいインスタンスを生成する
    Dim Fso As FileSystemObject
    Set Fso = New FileSystemObject

' Folder オブジェクトを取得する
    Set hRootFolder = Fso.GetFolder(nRootPath)

' このディレクトリ内のすべてのサブディレクトリを検索する (再帰)
    For Each hSubFolder In hRootFolder.SubFolders
        If StrConv(hSubFolder.Name, vbUpperCase) Like nPattern Then
            lIndex = lIndex + 1
            ReDim Preserve nReturns(lIndex)
            nReturns(lIndex) = nRootPath & "\" & hSubFolder.Name

nFilePathes() = GetFoldersMostDeep(hSubFolder.Path, nPattern)

' ファイルが格納されている要素数を取得する
            lBounds = UBound(nFilePathes())

For lCopy = 1 To lBounds
                If StrConv(Fso.GetFolder(nFilePathes(lCopy)).Name, vbUpperCase) Like nPattern Then
                    lIndex = lIndex + 1
                    ReDim Preserve nReturns(lIndex)
                    nReturns(lIndex) = nFilePathes(lCopy)
                End If
            Next lCopy
    Next hSubFolder

' 不要になった時点で破棄する
    Set Fso         = Nothing
    Set hSubFolder  = Nothing
    Set hRootFolder = Nothing

' 取得したすべてのフォルダを返す
    GetFoldersMostDeep = nReturns
End Function

←解決時は質問者本人がここをチェックしてください。

戻る