| |
▼さくら さん：
>重複する質問で申し訳有りません＆情報ありがとうございました！
neptune さんがリンクで紹介されているスレッドは主として
検索スピードが話題の中心でしたので、FindFirstFileW 系の
API高速検索を使っていますが、
同じロジックで Dir$関数の再帰処理によるサブフォルダの検索
も可能です。
参考まで。
Sub さくら3()
Dim LookIn As String: LookIn = "D:\(Data)\" '◆検索Rootフォルダ
Dim Filename As String: Filename = "*.xls"
Dim FoundFiles() As String
Dim nCount As Long
Dim mCount As Long
Dim i As Long
'LookIn : 検索Rootフォルダ
'Filename : 検索ファイル名
'FoundFiles(): マッチしたファイル名の配列()
'nCount : ファイルの数
FileSearch LookIn, Filename, FoundFiles(), nCount, mCount, 0
If (nCount - mCount) > 0 Then
With Worksheets
With .Add(After:=.Item(.Count))
.[A1].Resize(nCount, 2).Value = Trans(FoundFiles())
End With
End With
MsgBox nCount - mCount & "個のファイルがマッチしました"
End If
End Sub
' サブフォルダを含むファイルの検索
Sub FileSearch(ByVal strDir As String, strFind As String, _
FoundFiles() As String, nCount As Long, _
mCount As Long, ByVal Level As Long)
Dim SubDirs() As String
Dim strName As String
Dim lngCount As Long
Dim i As Long
If Right$(strDir, 1) <> "\" Then strDir = strDir & "\"
strFind = LCase$(strFind)
If Level <= 1 Then 'Rootフォルダおよび直下のサブフォルダのとき
nCount = nCount + 1
mCount = mCount + 1
ReDim Preserve FoundFiles(1, 1 To nCount)
FoundFiles(0, nCount) = strDir
End If
On Error GoTo err_Dir
'サブフォルダ名を含む全てのファイルを検索
strName = Dir$(strDir, vbDirectory Or vbReadOnly _
Or vbHidden Or vbSystem)
Level = Level + 1
While Len(strName)
If GetAttr(strDir & strName) And vbDirectory Then
' サブフォルダならば 配列に一時記憶
If Not strName Like ".*" Then
lngCount = lngCount + 1
ReDim Preserve SubDirs(1 To lngCount)
SubDirs(lngCount) = strName
End If
ElseIf LCase$(strName) Like strFind Then
' 検索ファイル名にマッチしたファイル
nCount = nCount + 1
ReDim Preserve FoundFiles(1, 1 To nCount)
FoundFiles(1, nCount) = strName
End If
Next_Dir:
strName = Dir$()
Wend
' サブフォルダ内の検索
For i = 1 To lngCount
FileSearch strDir & SubDirs(i), strFind, _
FoundFiles(), nCount, mCount, Level
Next
Exit Sub
err_Dir:
Debug.Print Err().Description, strDir & strName
Resume Next_Dir
End Sub
'配列のTranspose
Private Function Trans(ff() As String) As String()
Dim sv() As String
Dim i As Long, n As Long
n = UBound(ff, 2)
ReDim sv(1 To n, 1)
For i = 1 To n
sv(i, 0) = ff(0, i)
sv(i, 1) = ff(1, i)
Next
Trans = sv()
End Function
（注）Dir()関数はUnicodeファイル名に対応していないので、
アラビア語やタイ語のファイル名があると失敗します。
再帰処理プロシージャ内の
On Error GoTo err_Dir
は、そのエラー処理宣言です。
なお、同様の処理はFso（Scripting.FileSystemObject） でも可能ですが、
速度に問題があるので、個人的には Dirを使った再帰Loopのほうが
お手軽かと思います。
もちろん、リンク先の Unicode APIのほうがDir Loopより高速で
パスの長さに対する制限もありませんので、よく使う場合は そちらを
どうぞ(^^
|
|
kanabun
- 09/9/28(月) 14:47 -
