Excelでフォルダ内文字列検索ソフトを作ってみよう

'ファイルを開き読む
Private Function MyFileRead(fname As String) As Boolean
    Dim fn As Long
    Dim buf As String
    Dim tmp As String
    Dim lLine As Long
    Dim lPos As Long
    
    '一気に読み込みチェック
    fn = FreeFile
    buf = Space(FileLen(fname))
    Open fname For Binary As #fn
        Get #fn, , buf
    Close #fn
    
    MyFileRead = False
    If InStr(1, buf, TextBox1.Value) = 0 Then
        Exit Function
    End If
    
    lLine = 0
    fn = FreeFile
    'ファイルを開く
    Open fname For Input As #fn
        
        Do Until EOF(fn)
            '一行読込み
            Line Input #fn, tmp
            lLine = lLine + 1
            lPos = InStr(1, tmp, TextBox1.Value)
            If lPos <> 0 Then
                MyFileRead = True
            End If
        Loop
    Close #fn
End Function

Private Sub ExFolderSearchSub(ByVal tPath As Folder, ByRef lrow As Long, ByVal lCol As Long)
    Dim tInPath As Folder
    Dim tFile As File
    Dim s1 As String
    Dim s2 As String
    Dim sPush As String
        
    Range(Cells(lrow, lCol), Cells(65536, lCol + 30)).ClearContents
    
    lPathCount = lPathCount + 1
    
    'サブフォルダ内の探索
    For Each tInPath In tPath.SubFolders
        '再帰呼び出し
        Call ExFolderSearchSub(tInPath, lrow, lCol)
    Next tInPath
    
    'フォルダ内のファイルを表示
    For Each tFile In tPath.Files
        s1 = LCase(ExGetExt(tFile.Name))
        If s1 = "txt" Or s1 = "html" Or s1 = "htm" Then
            s2 = tPath.Path
            If Right(s2, 1) <> "\" Then s2 = s2 & "\"
            If MyFileRead(s2 & tFile.Name) Then
                If sPush <> tPath.Name Then
                    lrow = lrow + 1
                    Cells(lrow, lCol).Value = tPath.Path
                    sPush = tPath.Name
                End If
                lrow = lrow + 1
                lFileCount = lFileCount + 1
                'セル内右寄せ
                Cells(lrow, lCol).HorizontalAlignment = xlHAlignRight
                Cells(lrow, lCol) = "∟"
                Cells(lrow, lCol + 1) = tFile.Name & " (" & tFile.DateLastModified & ")"
            End If
        End If
    Next tFile
    Set tPath = Nothing
End Sub