● ファイルを検索する(旧) ●

もっといいアルゴリズムがあるかも…

ファイルを検索しちゃいましょう。Extension にファイル名を指定しても検索できるよ。(おそらく)

'ファイルタイム
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

'---------------------------------------------------------------
'  関数名: EnumFilePath
'  機能  : ファイルを検索する
'  引数  : (in) InitDir … 検索ディレクトリ
'           (in) Extension … 検索ファイル拡張子
'           (in) chkSubDir … サブフォルダ検索
'                              True…する  False…しない
'           (in) DistinctChar … 大文字小文字を区別する
'                              True…する  False…しない
'  返り値 : なし
'---------------------------------------------------------------
Public Sub EnumFilePath(ByVal InitDir As String, ByVal Extension As String, _
                           ByVal chkSubDir As Boolean, _
                          ByVal DistinctChar As Boolean)

    Dim udtWin32 As WIN32_FIND_DATA
    Dim FindDir As String    '検索するディレクトリ
    Dim hFile As Long        'ファイルハンドル
    Dim gFoundDir As String  '取得したディレクトリ
    Dim SearchPath As String  '検索ディレクトリ
    Dim NextFile As Long      '返り値

    '検索するディレクトリ
    If Right$(InitDir, 1) <> "\" Then InitDir = InitDir & "\"
    FindDir = InitDir & "*.*"

    '検索開始
    hFile = FindFirstFile(FindDir, udtWin32)

    '初期化
    NextFile = -1

    Do While NextFile <> 0&
          DoEvents

          'Nullをカットしてディレクトリ名・ファイル名を取得する
          gFoundDir = Left$(udtWin32.cFileName, InStr(udtWin32.cFileName, Chr$(0)) - 1)

          '検索ディレクトリ
          SearchPath = InitDir & gFoundDir

          'フォルダである
          If (udtWin32.dwFileAttributes And vbDirectory) = vbDirectory Then
                '親フォルダ、カレントフォルダは無視
                If Left$(gFoundDir, 1) <> "." Then
                      'サブフォルダチェック
                      If chkSubDir = True Then
                            '再帰呼び出し
                            Call EnumFilePath(SearchPath, Extension, True, DistinctChar)
                      End If
                End If
          'ファイルである
          Else
                '拡張子が指定拡張子と等しい
                If UCase$(Right$(SearchPath, Len(Extension))) = UCase$(Extension) Then
                      Debug.Print SearchPath  '表示
                End If
          End If

          '次のファイルを検索
          NextFile = FindNextFile(hFile, udtWin32)
    Loop

    Call FindClose(hFile)

End Sub

なんとなく、UCase$(Right$(SearchPath, Len(Extension))) = UCase$(Extension) というところが無駄である気がする。もっといいアルゴリズムがありそう。


戻る