[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.