Untitled
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