Untitled
unknown
plain_text
a year ago
4.7 kB
11
Indexable
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 SubEditor is loading...
Leave a Comment