こんにちは。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
お礼
ありがとうございました 試してみますね!