テキストファイルの簡易全文検索
 サンプルでは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

Excel97,2000



戻る


Excel Word Access VBA! モーグ