サンプルではFileSearchオブジェクトを利用して指定フォルダ以下の
テキストファイルを検出、順にOpenステートメントで開き、Instr関数
で検索文字が含まれるかどうかを調べています。
※文字位置を利用するケースを考慮してInstr関数を利用しています。
Option Base 1
Private Sub CommandButton1_Click()
Dim TargetFolder As String
Dim Data As String, SearchStr As String
Dim Result() As String, cntResult As Integer
Dim i As Integer, FileNum As Integer
FileNum = FreeFile 'ファイル番号
TargetFolder = "C:\TEST" '指定フォルダ
SearchStr = "エクセル" '検索文字列
'テキストファイルの検出
With Application.FileSearch
.NewSearch
.Filename = "*.txt"
.FileType = msoFileTypeAllFiles
.LookIn = TargetFolder
.SearchSubFolders = False
.Execute
If .FoundFiles.Count = 0 Then Exit Sub
'検出したファイル数文ループ
For i = 1 To .FoundFiles.Count
'テキストをBinaryオープンしてからInput関数で一括読み込み
Open .FoundFiles(i) For Binary As FileNum
Data = Input(LOF(FileNum), FileNum)
'Instr関数で検索文字列の位置を確認。0なら含まれていない。
If InStr(1, Data, SearchStr, vbTextCompare) <> 0 Then
'対照文字列が含まれている場合に配列変数Resultに格納
cntResult = cntResult + 1
ReDim Preserve Result(cntResult)
Result(cntResult) = .FoundFiles(i)
End If
Close FileNum
Next i
End With
'検索結果を2元配列に変換してセルに転記。
ActiveSheet.Range(Cells(1, 1), Cells(UBound(Result), 1)).Value = _
Application.WorksheetFunction.Transpose(Result)
End Sub
|