VBでのファイル検索（API以外で）

誰か教えていただければうれしいです

VBでファイル検索をしたいのですが
まず利用可能なドライブを取得して
ドライブごとに検索してファイルがあれば
その絶対パスとファイルのあったドライブ名を
グローバル変数に格納したいのですが
API関数を使わない方法がわかりません

わかるかたがいらっしゃれば教えていただけないでしょうか

No.1 ベストアンサー 回答者： maruru01 回答日時： 2002/01/07 16:30

こんにちは。

maruru01です。
自作ですが。
この例では、ファイル名をフルパスで返しますので、ドライブ名が欲しかったら、切り出して下さい。
また、この例では、あるフォルダ内の下部階層まで検索します。したがって、フォルダにドライブ名（a:\など）を指定してやればドライブごとに検索出来ます。
また、この例では、隠しファイルなど特殊な属性のファイルは検索出来ませんので、必要に応じてDIR関数の第2引数をいじって下さい。
では。

***** 標準モジュールに *****
'SearchFol内の全ファイルを対象にSearchFileを探し、あればフルパスで返す
Public Function AllDirSearchFile(SearchFol As String, searchFile As String, Optional searchMode As Integer = vbBinaryCompare) As String

　　Dim sf As String 'パスなしのSearchFile
　　Dim setPath As String '現在のパス
　　Dim checkName As String '調べるファイル(フォルダ)
　　Dim checkFlag As Boolean '繰り返しの終了判定
　　Dim pathCount As Integer '処理するパスの個数
　　Dim pathList() As String 'パス名のリスト
　　
　　AllDirSearchFile = ""
　　
　　sf = MakeFileName(searchFile)
　　
　　If (GetAttr(SearchFol) And vbDirectory) <> 0 Then
　　　　If Right(SearchFol, 1) <> "\" Then
　　　　　　SearchFol = SearchFol & "\"
　　　　End If
　　　　
　　　　pathCount = 0
　　　　setPath = SearchFol
　　　　checkFlag = True
　　　　Do While checkFlag = True
　　　　　　checkName = Dir(setPath & "*.*", vbDirectory)
　　　　　　Do While checkName <> ""
　　　　　　　　If checkName <> "." And checkName <> ".." Then
　　　　　　　　　　If (GetAttr(setPath & checkName) And vbDirectory) <> 0 Then
　　　　　　　　　　　　pathCount = pathCount + 1
　　　　　　　　　　　　ReDim Preserve pathList(pathCount)
　　　　　　　　　　　　pathList(pathCount) = setPath & checkName
　　　　　　　　　　Else
　　　　　　　　　　　　If StrComp(checkName, sf, searchMode) = 0 Then
　　　　　　　　　　　　　　AllDirSearchFile = setPath & checkName
　　　　　　　　　　　　　　Exit Function
　　　　　　　　　　　　End If
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　　checkName = Dir()
　　　　　　Loop
　　　　　　If pathCount = 0 Then
　　　　　　　　checkFlag = False
　　　　　　Else
　　　　　　　　setPath = pathList(pathCount) & "\"
　　　　　　　　pathCount = pathCount - 1
　　　　　　End If
　　　　Loop
　　Else
　　　　If StrComp(MakeFileName(SearchFol), sf, searchMode) = 0 Then
　　　　　　AllDirSearchFile = SearchFol
　　　　End If
　　End If
　　
End Function


' フルパスからファイル名を取り出す
Public Function MakeFileName(fileName As String) As String

　　Dim z0 As Long
　　
　　z0 = InStrRev(fileName, "\")
　　If z0 <> 0 Then
　　　　MakeFileName = Mid(fileName, z0 + 1)
　　Else
　　　　MakeFileName = fileName
　　End If
　　
End Function

この回答へのお礼

ありがとうございました
試してみますね！

お礼日時：2002/01/07 18:25