Untitled

mail@pastecode.io avatar
unknown
plain_text
19 days ago
4.7 kB
3
Indexable
Never
Option Explicit
Sub SearchInAllFiles()
    Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$
    Dim myFile As String, textLine As String
    Dim searchTerm As String
    Dim fso As Object
    Dim fileStream As Object
    Dim ext As String
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim excelApp As Object
    Dim excelWb As Workbook
    Dim ws As Worksheet
    Dim cell As Range
    
    ' Set initial folder
    InitialFoldr$ = "C:\"
    
    ' Get search term from user
    searchTerm = InputBox("Enter the term you want to search for:", "Search Term")
    If searchTerm = "" Then Exit Sub
    
    ' Show folder picker dialog
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to search files from"
        .InitialFileName = InitialFoldr$
        .Show
        
        ' Check if folder was selected
        If .SelectedItems.Count <> 0 Then
            xDirect$ = .SelectedItems(1) & "\"
            xFname$ = Dir(xDirect$ & "*.*", vbNormal) ' Search for all file types
            
            ' Create FileSystemObject for text-based files
            Set fso = CreateObject("Scripting.FileSystemObject")
            
            ' Initialize row counter for output
            xRow = 0
            
            ' Loop through all files in the selected directory
            Do While xFname$ <> ""
                ext = LCase(Mid(xFname$, InStrRev(xFname$, ".") + 1)) ' Get file extension
                
                ' Handle .txt, .csv, .log files
                If ext = "txt" Or ext = "csv" Or ext = "log" Then
                    Set fileStream = fso.OpenTextFile(xDirect$ & xFname$, 1) ' Open file in read-only mode
                    Do While Not fileStream.AtEndOfStream
                        textLine = fileStream.ReadLine
                        ' Search for the term
                        If InStr(1, textLine, searchTerm, vbTextCompare) > 0 Then
                            ' Output the file name and matching line
                            ActiveCell.Offset(xRow, 0).Value = xFname$
                            ActiveCell.Offset(xRow, 1).Value = textLine
                            xRow = xRow + 1
                        End If
                    Loop
                    fileStream.Close
                
                ' Handle Word files (.docx, .doc)
                ElseIf ext = "docx" Or ext = "doc" Then
                    ' Initialize Word application if not already done
                    If wordApp Is Nothing Then Set wordApp = CreateObject("Word.Application")
                    Set wordDoc = wordApp.Documents.Open(xDirect$ & xFname$, ReadOnly:=True)
                    
                    ' Search the content of the Word document
                    If InStr(1, wordDoc.Content.Text, searchTerm, vbTextCompare) > 0 Then
                        ActiveCell.Offset(xRow, 0).Value = xFname$
                        ActiveCell.Offset(xRow, 1).Value = "Term found in Word document."
                        xRow = xRow + 1
                    End If
                    wordDoc.Close False ' Close without saving
                
                ' Handle Excel files (.xlsx, .xls)
                ElseIf ext = "xlsx" Or ext = "xls" Then
                    ' Initialize Excel application if not already done
                    If excelApp Is Nothing Then Set excelApp = CreateObject("Excel.Application")
                    excelApp.Visible = False ' Keep Excel hidden
                    Set excelWb = excelApp.Workbooks.Open(xDirect$ & xFname$, ReadOnly:=True)
                    
                    ' Loop through all sheets and cells
                    For Each ws In excelWb.Sheets
                        For Each cell In ws.UsedRange
                            If InStr(1, cell.Value, searchTerm, vbTextCompare) > 0 Then
                                ActiveCell.Offset(xRow, 0).Value = xFname$
                                ActiveCell.Offset(xRow, 1).Value = "Term found in Excel file."
                                xRow = xRow + 1
                                Exit For ' If you want to stop after the first match
                            End If
                        Next cell
                    Next ws
                    excelWb.Close False ' Close without saving
                End If
                
                ' Move to the next file
                xFname$ = Dir
            Loop
            
            ' Clean up objects
            If Not wordApp Is Nothing Then wordApp.Quit
            If Not excelApp Is Nothing Then excelApp.Quit
        End If
    End With
End Sub
Leave a Comment