● ファイルを検索する - その1 ●

それなりに速いかもしれない。一応、旧版もあるよ。
捨てプログラム的で良いなら、『Dir$を使用した検索』もあるよ。

'ファイルタイム
Private Type FILETIME
     dwLowDateTime As Long
     dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
     dwFileAttributes As Long       'ファイル属性
     ftCreationTime As FILETIME     '作成日
     ftLastAccessTime As FILETIME   'アクセス日
     ftLastWriteTime As FILETIME    '更新日
     nFileSizeHigh As Long          'ファイルサイズ(Byte)
     nFileSizeLow As Long           'ファイルサイズ(Byte)
     dwReserved0 As Long            '未使用
     dwReserved1 As Long            '未使用
     cFileName As String * 260      'ファイル名
     cAlternate As String * 14      'ファイル名フォーマット名
End Type

'ファイルの検索を開始する
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

'ファイルの検索を続行する
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

'検索ハンドルを閉じる
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Const INVALID_HANDLE_VALUE = -1

Private Type DIR_FILE_LIST
    FileName As String
    IsDirectory As Boolean
End Type

'----------------------------------------------------------------------- ' 関数名 : GetTargetFiles ' 機能 : ディレクトリ以下の指定拡張子のファイルを取得する ' 引数 : (in/out) Files … 取得したファイルを格納する配列 ' (in)DirName … 検索元ディレクトリ ' (in)Extension … 拡張子 ' 返り値 : True:検索元ディレクトリは存在する False:存在しない '----------------------------------------------------------------------- Public Function GetTargetFiles(ByRef Files() As String, ByVal DirName As String, _ ByVal Extension As String) As Boolean Dim udtWin32 As WIN32_FIND_DATA Dim hFile As Long Dim ArrayIndex As Long Dim FileListNum As Long Dim i As Long Dim UdtDFL() As DIR_FILE_LIST '最後尾に \ が付いている場合は取る If Right$(DirName, 1) = "\" Then DirName = Left$(DirName, Len(DirName) - 1) '検索開始 hFile = FindFirstFile(DirName, udtWin32) 'ファイル・ディレクトリが存在しない場合は終了 If hFile = INVALID_HANDLE_VALUE Then Exit Function Call FindClose(hFile) 'ディレクトリ以下のファイル・ディレクトリを取得する FileListNum = GetFileList(UdtDFL, DirName) If FileListNum = (-1) Then Exit Function For i = 0 To FileListNum 'ディレクトリである If UdtDFL(i).IsDirectory Then Call GetTargetFiles(Files, DirName & "\" & UdtDFL(i).FileName, Extension) 'ファイルである Else 'ファイルの拡張子が指定拡張子と等しい If UCase$(Right$(UdtDFL(i).FileName, Len(Extension))) = UCase$(Extension) Then '初回実行時 Files は配列無しなのでUBound()でエラーとなる 'それを回避するための強制エラー無視ロジック On Error Resume Next ArrayIndex = UBound(Files) + 1 On Error GoTo 0 'メモリー確保 ReDim Preserve Files(ArrayIndex) As String 'フルパスでファイル名を格納 Files(ArrayIndex) = DirName & "\" & UdtDFL(i).FileName End If End If Next i GetTargetFiles = True End Function '----------------------------------------------------------------------- ' 関数名 : GetFileList ' 機能 : ディレクトリのファイルを取得する ' 引数 : (in/out) UdtDFL … DIR_FILE_LIST構造体の配列 ' (in)DirName … 検索元ディレクトリ ' 返り値 : UdtDFL配列数 ファイルが存在しない場合:-1 '----------------------------------------------------------------------- Public Function GetFileList(ByRef UdtDFL() As DIR_FILE_LIST, _ ByVal DirName As String) As Long Dim udtWin32 As WIN32_FIND_DATA Dim hFile As Long Dim ArrayIndex As Long Dim Win32FileName As String ArrayIndex = (-1) '検索開始 hFile = FindFirstFile(DirName & "\*", udtWin32) Do '時々、再描画してあげましょう If ArrayIndex Mod 10 = 0 Then DoEvents 'ファイル名取得 Win32FileName = Left$(udtWin32.cFileName, _ InStr(udtWin32.cFileName, Chr$(0)) - 1) '親ディレクトリ、カレントディレクトリでない If Left$(Win32FileName, 1) <> "." Then ArrayIndex = ArrayIndex + 1 ReDim Preserve UdtDFL(ArrayIndex) As DIR_FILE_LIST 'ファイル名、ファイル属性を取得 With UdtDFL(ArrayIndex) .FileName = Win32FileName .IsDirectory = CBool(udtWin32.dwFileAttributes And vbDirectory) End With End If Loop While FindNextFile(hFile, udtWin32) <> 0 Call FindClose(hFile) GetFileList = ArrayIndex End Function 以下は実行ロジック。しかも検索時間表示付き!! Private Declare Function GetTickCount Lib "kernel32" () As Long Private Sub Command1_Click() Dim FileList() As String Dim i As Long Dim StartTime As Long Dim EndTime As Long '開始時間を取得 StartTime = GetTickCount If GetTargetFiles(FileList, "C:\Program Files", "txt") Then '終了時間を取得 EndTime = GetTickCount For i = 0 To UBound(FileList) Debug.Print FileList(i) Next i Debug.Print CStr(i) & "個のファイルが見つかりました(検索時間:" & _ Format$((EndTime - StartTime) / 1000, "0.00") & "秒)" End If End Sub


戻る