即効テクニック |
サンプルでは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