| |
▼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以外では、
＞ 【その２ コマンドプロンプト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 秒でした。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
