Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


23844 / 76732 ←次へ | 前へ→

【58244】Re:再帰処理でのファイル検索
発言  kanabun  - 08/10/14(火) 1:25 -

引用なし
パスワード
   ▼neptune さん、ありがとうございます。
> ▼kanabun さん:
> ちょっとだけお邪魔します。
>
> 宣言部分だけ何とかなりそうなので一応書いておきます。

> ヘッダーファイルから拾いました。
>
> Public Enum FINDEX_INFO_LEVELS
>   FindExInfoStandard
>   FindExInfoMaxInfoLevel
> End Enum
> Public Enum FINDEX_SEARCH_OPS
>   FindExSearchNameMatch
>   FindExSearchLimitToDirectories
>   FindExSearchLimitToDevices
>   FindExSearchMaxSearchOp
> End Enum
>
> '多分lpSearchFilterは0で良いと思います。

> Public Enum FINDEX_SEARCH_OPS

>   FindExSearchLimitToDirectories
が、文字通りに解釈すると、「Directoryだけに制限する」と
読めるので、早速、これを取り入れてみました。

'-------------------------------------
Option Explicit

Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = (-1)

' WIN32_FIND_DATA構造体
Private Type WIN32_FIND_DATA
  dwFileAttributes  As Long
  ftCreationTime   As Currency
  ftLastAccessTime  As Currency
  ftLastWriteTime   As Currency
  nFileSizeHigh    As Long
  nFileSizeLow    As Long
  dwReserved0     As Long
  dwReserved1     As Long
  cFileName(1 To MAX_PATH * 2) As Byte 'Unicode
  cAlternate(1 To 14 * 2) As Byte    'Unicode
End Type

Private Declare Function FindFirstFile _
       Lib "kernel32" Alias "FindFirstFileW" _
        (ByVal lpFileName As Long, _
        lpFindFileData As WIN32_FIND_DATA) As Long

Public Enum FINDEX_INFO_LEVELS
  FindExInfoStandard
  FindExInfoMaxInfoLevel
End Enum
Public Enum FINDEX_SEARCH_OPS
  FindExSearchNameMatch
  FindExSearchLimitToDirectories
  FindExSearchLimitToDevices
  FindExSearchMaxSearchOp
End Enum

Declare Function FindFirstFileEx& _
      Lib "kernel32" Alias "FindFirstFileExW" _
       (ByVal lpFileName&, _
        ByVal InfoLevelIdReserved&, _
        lpFindFileData As WIN32_FIND_DATA, _
        ByVal SearchOp&, _
        ByVal lpSearchFilterReserved&, _
        ByVal dwAdditionalFlagsReserved&)

' LPCTSTR lpFileName,       // 検索するファイル名
' FINDEX_INFO_LEVELS fInfoLevelId, // データの情報レベル
' LPVOID lpFindFileData,      // 返された情報へのポインタ
' FINDEX_SEARCH_OPS fSearchOp,   // 実行するフィルタ処理のタイプ
' LPVOID lpSearchFilter,      // 検索条件へのポインタ
' DWORD dwAdditionalFlags     // 補足的な検索制御フラグ

Private Declare Function FindNextFile _
       Lib "kernel32" Alias "FindNextFileW" _
         (ByVal hFindFile As Long, _
         lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose _
       Lib "kernel32" _
         (ByVal hFindFile As Long) As Long
'-------------------------------------------------------------

Sub Try_FindFileEx()
  Dim myPath As String
  Dim strFind As String
  Dim f As String
  Dim n&
  Dim myList() As String
  Dim t!
  
  t = Timer()
  myPath = "D:\(Data)"
  strFind = "abc.*"
    FindFileEx myPath, strFind, myList(), n '★呼び出し
  
  Debug.Print "'★Try_FindFileEx"; Timer() - t
  If n Then
    MsgBox Join(myList, vbCr), _
      , strFind & " ---> " & n & " Files"
  Else
    MsgBox "該当ファイルなし"
  End If
End Sub

Private Sub FindFileEx(Pathname$, strFind$, myList$(), _
      fCount&, Optional SearchChild As Boolean = True)
 Dim p As String
 Dim fDATA As WIN32_FIND_DATA
 Dim lngAttribute As Long
 Dim f As String
 Dim hFile As Long
 Dim SubDirs() As String, nSub As Long, i As Long

 If Right$(Pathname, 1) <> "\" Then Pathname = Pathname & "\"
 
 '指定フォルダ内の指定ファイルの検索
 p = Pathname & strFind
 hFile = FindFirstFile(StrPtr(p), fDATA)
 If hFile <> INVALID_HANDLE_VALUE Then
   Do
     f = fDATA.cFileName
     f = Left$(f, InStr(f, vbNullChar) - 1)
     If (fDATA.dwFileAttributes And vbDirectory) = 0 Then
       fCount = fCount + 1
       ReDim Preserve myList(1 To fCount)
       myList(fCount) = Pathname & f
     End If
   Loop While FindNextFile(hFile, fDATA)
   FindClose hFile
 End If
 
 'つぎに 指定パス 内のサブフォルダの検索をおこなう
 If SearchChild Then
   p = Pathname & "*"
   hFile = FindFirstFileEx(StrPtr(p), _
               0&, _
               fDATA, _
               FindExSearchLimitToDirectories, _
               0&, _
               0&)
   If hFile = INVALID_HANDLE_VALUE Then Exit Sub
   Do
     f = fDATA.cFileName
     f = Left$(f, InStr(f, vbNullChar) - 1)
     If (fDATA.dwFileAttributes And vbDirectory) Then
       If Not f Like ".*" Then
         nSub = nSub + 1
         ReDim Preserve SubDirs(1 To nSub)
         SubDirs(nSub) = Pathname & f
       End If
     End If
   Loop While FindNextFile(hFile, fDATA)
   FindClose hFile
 
   If nSub Then
     For i = 1 To nSub
       'サブフォルダ内の指定ファイルの検索
       FindFileEx SubDirs(i), strFind, myList(), fCount
     Next
   End If
 End If

End Sub

'----------------------
しかし、FindExSearchLimitToDirectories を指定しているにも
かかわらず、残念ながら、これでもファイルが検索されてしまい
ました。。。
> ですが、MSDNをさまよってみましたが、findfirstfileexが一番
> 可能性ありそうな気はします?
いいところまで来たのか、無駄な努力をしているのか?
その辺が知りたいです。。

あと、マクロマンさんご紹介の「目安箱」のなかに、
ちゃっぴさんのサブフォルダを含むファイルの一覧の
各種サンプルがありますが、FindFile系API以外では、
>  【その2 コマンドプロンプトDIRコマンド Version】
>'【要参照】「Windows Scripting Host Object Model」

が、有効なことを再認識しました。(^^
<引用>
>ファイルの入出力を介しますが、FSOよりも動作が速いのが魅力です。
>また、サブフォルダの検索のOn/Offをオプション"/S"だけで
>切り替えられるのも魅力です。
>
>ただ、残念なことにOSに依存します。 </引用>

(↓kanabun が変数名など勝手に変えちゃってます)
Sub RunDir() 
  Dim oWShell   As WshShell
  Dim objRedirectFile As File
  Dim objRedirectTXT As TextStream
  Dim strPathFilename  As String    '対象フォルダパス
  Dim strRedirectPath As String     '一時ファイルパス
  Dim ko    As Long
  Dim varFileList   As Variant
  Dim t!
  
  t = Timer
  Set oWShell = New WshShell
 
  strPathFilename = "D:\(Data)\abc.*"
  strRedirectPath = "D:\(Data)\Temp\DirTemp.txt"
  
  ko = oWShell.Run("CMD /C DIR """ & strPathFilename _
    & """ /A-D /B /S > """ & strRedirectPath & """", 7, True)
  Set oWShell = Nothing

  If ko = 0 Then
    Dim io As Integer
    Dim ss As String
    
    io = FreeFile()
    Open strRedirectPath For Binary As io
    ReDim buf(1 To LOF(io)) As Byte
    Get #io, , buf
    Close io
    ss = StrConv(buf, vbUnicode)
  End If
  t = Timer - t
  MsgBox ss,,t
End Sub

あるフォルダ内の "abc*.xls" というファイルを
サブフォルダも含めて
通常のDirの再帰で検索すると、 7.2秒、
Sub RunDir() で検索すると、  2.4〜2.7秒、
このスレッドで最初に提示して(削除してしまった)
★Try_FindFileO で検索すると、 1.72秒
といった感じです。
★Try_FindFileO は、よく見るアルゴリズム
( FindFirstFile で フォルダ内のすべてのファイルを検索し、
  その中から、指定したパターンと一致するファイルを取り出し、
  同時に、属性がDirectoryであれば 自身を再帰呼び出しする )
なので、Dirの再帰と同じアルゴリズムなのです。
Dir関数 も FindFirstFile関数も ワイルドカードを使った
特定のファイルの検索ができるのに、サブフォルダの検索も
やろうとなると、とたんに FileSystemObject同様、すべての
ファイルを取得しなければならない。そこが効率悪いと思うのに
(1) 指定ファイル("abc*.xls")の検索
(2) サブフォルダの検索
をしているサンプルが、いまのところ、どこにもないということは
FindFirstFileExでも、(2)ができないんでしょうかね?

(1)はFindFirstFileで、
(2)の部分だけ Fso.GetFolder(Pathname).SubFolders
で実験してみた結果は、 7.0 秒でした。
0 hits

【58198】再帰処理でのファイル検索 ON 08/10/10(金) 19:56 質問
【58199】Re:再帰処理でのファイル検索 マクロマン 08/10/10(金) 20:37 発言
【58202】Re:再帰処理でのファイル検索 kanabun 08/10/11(土) 11:13 発言
【58203】Re:再帰処理でのファイル検索 kanabun 08/10/11(土) 11:29 発言
【58227】Re:再帰処理でのファイル検索 熊谷隆史 08/10/12(日) 16:24 発言
【58232】Re:再帰処理でのファイル検索 ON 08/10/12(日) 23:19 お礼
【58236】Re:再帰処理でのファイル検索 ON 08/10/13(月) 9:52 質問
【58250】Re:再帰処理でのファイル検索 熊谷隆史 08/10/14(火) 15:43 発言
【58251】Re:再帰処理でのファイル検索 kanabun 08/10/14(火) 17:39 発言
【58252】Re:再帰処理でのファイル検索 neptune 08/10/14(火) 21:41 発言
【58253】Re:再帰処理でのファイル検索 kanabun 08/10/14(火) 22:15 発言
【58255】Re:再帰処理でのファイル検索 neptune 08/10/14(火) 22:48 発言
【58256】Re:再帰処理でのファイル検索 jet 08/10/14(火) 23:41 回答
【58239】Re:再帰処理でのファイル検索 kanabun 08/10/13(月) 13:55 発言
【58243】Re:再帰処理でのファイル検索 neptune 08/10/13(月) 22:25 発言
【58244】Re:再帰処理でのファイル検索 kanabun 08/10/14(火) 1:25 発言
【58261】Re:再帰処理でのファイル検索 ON 08/10/15(水) 13:25 お礼
【58263】Re:再帰処理でのファイル検索 熊谷隆史 08/10/15(水) 13:43 発言
【58271】Re:再帰処理でのファイル検索 ON 08/10/15(水) 19:40 お礼
【58333】Re:再帰処理でのファイル検索 熊谷隆史 08/10/20(月) 10:47 発言
【58871】Re:再帰処理でのファイル検索 ON 08/11/15(土) 0:23 お礼

23844 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free