[[20140412153555]]　『Application.FileSearchの代替』（おやじ）　ページの最後に飛ぶ

『Application.FileSearchの代替』（おやじ）

エクセル2003からの移行で書き換えなければならないんですが、
素人なものでどうすればいいのか分かりません。
もし分かる方がいればよろしくお願いします。

    '検索開始
    With Application.FileSearch
        .NewSearch
        .LookIn = data_volume
        .SearchSubFolders = False
        .Filename = "*かわら版*"     '検索条件
        .FileType = msoFileTypeExcelWorkbooks

        If Err = 0 And .Execute > 0 Then
            '見つかったファイルの数
            data_findnumber = .FoundFiles.Count

            'すべてのファイルに対して
            For j = 1 To data_findnumber
                'ファイル名部分とディレクトリ部分に分割
                data_filename = .FoundFiles(j)
                If data_filename <> "" Then
                    '\の前後で分割
                    n = rekeyword(data_filename, "\", 2)
                    'ディレクトリ
                    data_kawaradir(j) = Left(data_filename, Len(data_filename) - n)
                    'ファイル名
                    data_kawarafilename(j) = Right(data_filename, n)

                    'リストボックスへファイル名を送る。(半角40スペース空けてディレクトリ）
                    ListBox1.AddItem data_kawarafilename(j) & "                                        |" & data_kawaradir(j)

                End If
            Next
        End If
    End With

＜使用 Excel：unknown、使用 OS：unknown ＞

 Dirコマンドで FileSearchの代替 やらしてみました。
 ただ、サブ・ディレクトリは検索しない仕様のようですので、
 Dirコマンドを使うとファイル名のみしか出力されません。
 SearchSubFolders = False のときは、
 FileSearch関数の中で ディレクトリ名を付加していますが、
 それを呼び出し側でまた ディレクトリ名とファイル名に分割するのですから、
 あまり効率がよくないです。

 SearchSubFolders = True  'サブフォルダも検索する

 とすれば、効率よく処理できます。

 コードは UserFormのInitialize() に書きましたが、独立させてもいいです。

 Private Sub UserForm_Initialize()
    Dim LookIn As String
    Dim Filename As String
    Dim SearchSubFolders As Boolean
    Dim data_volume As String
    Dim data_filename As String
    Dim j As Long, n As Long
    Dim FoundFiles() As String
    Dim data_kawaradir() As String
    Dim data_kawarafilename() As String

    '検索開始
    LookIn = "H:\(Data)" 'data_volume
    SearchSubFolders = False
    Filename = "*.Log" '"*かわら版*"     '検索条件

    n = FileSearch(LookIn, Filename, _
                    SearchSubFolders, FoundFiles())

    'n : 見つかったファイルの数
    If n > 0 Then
        ReDim data_kawaradir(1 To n)
        ReDim data_kawarafilename(1 To n)
        'みつかったすべてのファイルに対して
        For j = 1 To n
            'ファイル名部分とディレクトリ部分に分割
            data_filename = FoundFiles(j)
            n = InStrRev(data_filename, "\")
            'ディレクトリ
            data_kawaradir(j) = Left$(data_filename, n)
            'ファイル名
            data_kawarafilename(j) = Mid$(data_filename, n + 1)
            'リストボックスへファイル名を送る。(半角40スペース空けてディレクトリ）
            ListBox1.AddItem data_kawarafilename(j) & Space$(40) & "|" & data_kawaradir(j)
        Next
    End If
 End Sub

 'ファイルの検索  (これも UserForm のなかに 書きます)
 Private Function FileSearch(LookIn$, Filename$, _
            SearchSubFolder As Boolean, FoundFiles$()) As Long
    Dim tmpPath As String
    Dim sCmd As String
    Dim ko As Long

    '---- Dirコマンドによるファイルの検索
    If Right$(LookIn, 1) <> "\" Then LookIn = LookIn & "\"
    Filename = LookIn & Filename
    tmpPath = Environ$("Temp") & "\Dir.tmp" '一時ファイルパス

    sCmd = "DIR """ & Filename & """ /b/a:-D > """ & tmpPath & """"
    If SearchSubFolder Then sCmd = Replace(sCmd, "/b", "/b/s")
                      '' /b　ファイル名のみ
                      '' /s　サブディレクトリも検索
                      '' /a:-D サブディレクトリー名は表示しない

    With CreateObject("WScript.Shell")
        ko = .Run("CMD /C " & sCmd, 7, True) 'Dirコマンド実行(tmpファイルに出力)
    End With
    If ko Then
        MsgBox "ファイルの検索に失敗しました", , Filename
        Exit Function
    End If
    If FileLen(tmpPath) < 2 Then Exit Function 'ファイルが見つからなかった

    '----- Dirコマンドで取得したファイル名を配列に格納
    Dim i As Long, n As Long
    Dim io As Integer
    Dim buf() As Byte
    io = FreeFile()
    Open tmpPath For Binary As io
      ReDim buf(1 To LOF(io))
      Get #io, , buf
    Close io
    Kill tmpPath
    FoundFiles() = Split(vbCrLf & StrConv(buf, vbUnicode), vbCrLf)
    n = UBound(FoundFiles)
    FileSearch = n
    If Not SearchSubFolder Then
        For i = 1 To n
            FoundFiles(i) = LookIn & FoundFiles(i)
        Next
    End If
 End Function
（kanabun） 2014/04/12(土) 18:10

ありがとうございました！
（おやじ） 2014/04/16(水) 15:12

コメント返信：

[ 一覧(最新更新順) ]

[[20140412153555]] 『Application.FileSearchの代替』（おやじ） ページの最後に飛ぶ

[[20140412153555]]　『Application.FileSearchの代替』（おやじ）　ページの最後に飛ぶ