forex trading logo

Login


 

Search for strings

User Rating:  / 0
PoorBest 


The following code opens a dialog to search for a string in all files in a given directory.


Option Explicit
Sub SearchFoldersForContent()
Dim oRecordDoc As Word.Document, oSourceDoc As Word.Document
Dim bProtected As Boolean, lngProtType As Long
Dim oRng As Word.Range
Dim oDialog As FileDialog
Dim pFilename As String, pPath As String, pFind As String
Dim arrFind() As String
Dim i As Long, j As Long
'Pick folder containing files to search
Set oDialog = Application.FileDialog(msoFileDialogFolderPicker)
With oDialog
  .Title = "Select Folder Containing Files to Search"
  .AllowMultiSelect = False
  .InitialView = msoFileDialogViewList
  If .Show <> -1 Then
    MsgBox "You did not select a folder to process.", vbInformation + vbOKOnly, "PROCESS CANCELED"
    Exit Sub
  End If
  pPath = oDialog.SelectedItems.Item(1)
End With
If Right(pPath, 1) <> "\" Then pPath = pPath + "\"
'Get user defined search term/s
Do
  pFind = InputBox("Enter the word or text you want to find." & vbCr + vbCr _
                 & "To search for multiple terms separate each term with the pipe ""|"" character " & vbCr _
                 & "(e.g., Programmer|programmer|Software Developer", "SEARCH TERMS")
  pFind = RealInput(pFind)
  If pFind = "**Input canceled by user**" Then
    Exit Sub
  End If
Loop Until pFind <> ""
'Create the search array
arrFind = Split(pFind, "|")
'Develop informational text
pFind = ""
For i = 0 To UBound(arrFind)
  If i < UBound(arrFind) Then
    pFind = pFind & arrFind(i) & " - "
  Else
    pFind = pFind & arrFind(i)
  End If
Next i
Set oRecordDoc = ActiveDocument
'Set up report header, footer, heading text
With oRecordDoc
  With .Range
    .Text = "Results for Terms:  " & pFind & vbCr + vbCr
    .Paragraphs(1).SpaceBefore = 12
    .Paragraphs(1).SpaceAfter = 18
    .Paragraphs(1).Range.Font.Bold = True
  End With
    With .Sections(1).Headers(wdHeaderFooterPrimary).Range
    .Text = "Content Report for: " & pPath & vbCr & _
     "Created by: " & Application.UserName & vbCr & _
     "Creation date: " & Format(Date, "MMMM d, yyyy")
     With .ParagraphFormat.Borders(wdBorderBottom)
       .LineStyle = wdLineStyleSingle
       .LineWidth = wdLineWidth050pt
       .Color = wdColorAutomatic
     End With
     .ParagraphFormat.Borders.DistanceFromBottom = 3
  End With
  Set oRng = .Sections(1).Footers(wdHeaderFooterPrimary).Range
  With oRng
    .Text = ""
    .InsertBefore "Content Report" & vbTab + vbTab
    'Working backwards
    .Collapse wdCollapseEnd
    .Fields.Add oRng, Type:=wdFieldEmpty, Text:="NUMPAGES \* Arabic "
    .Collapse wdCollapseStart
    .Text = " of "
    .Collapse wdCollapseStart
    .Fields.Add oRng, Type:=wdFieldEmpty, Text:="PAGE \* Arabic"
    With .ParagraphFormat.Borders(wdBorderTop)
       .LineStyle = wdLineStyleSingle
       .LineWidth = wdLineWidth050pt
       .Color = wdColorAutomatic
    End With
  End With
End With
'Process the files in the selected folder
pFilename = Dir$(pPath & "*.doc?")
WordBasic.DisableAutoMacros 1
While Len(pFilename) <> 0
  'Open the document for processing
  Set oSourceDoc = Documents.Open(FileName:=pPath & pFilename, Visible:=False)
  'Determine protection status and unprotect if required
  bProtected = False
  If oSourceDoc.ProtectionType <> wdNoProtection Then
    bProtected = True
    lngProtType = oSourceDoc.ProtectionType
    oSourceDoc.Unprotect
  End If
  'Search for terms
  For i = 0 To UBound(arrFind)
    Set oRng = oSourceDoc.Range
    With oRng.Find
      .Execute FindText:=arrFind(i)
      'Process finding and terminate search
      If .Found Then
        j = j + 1
        oRecordDoc.Range.InsertAfter j & ".  " & pFilename & vbCr
        Exit For
      End If
    End With
  Next i
  If bProtected Then oSourceDoc.Protect lngProtType, True
  oSourceDoc.Close SaveChanges:=Word.wdDoNotSaveChanges
  'Get next file
  pFilename = Dir$()
Wend
WordBasic.DisableAutoMacros 0
oRecordDoc.Activate
oRecordDoc.Range.InsertAfter vbCr & "Number of files found: " & j & vbCr
End Sub
Function RealInput(pInput As String) As String
If StrPtr(pInput) = 0 Then
  MsgBox "This process cannot be executed unless a search string is defined.", vbInformation + vbOKOnly, "CANCELING PROCESS"
  RealInput = "**Input canceled by user**"
Else
  If pInput = "" Then
    RealInput = ""
    MsgBox "You did not provide an input.", vbInformation + vbOKOnly, "NOTHING DEFINED"
  Else
    RealInput = pInput
  End If
End If
End Function


 

Powered by Joomla!. Design by: joomla templates download  Valid XHTML and CSS.