Question about searching inside building blocks for specific text

[dbowlds]

I have a template that has a bunch of custom building blocks. The building blocks contain a mixture of text, graphics, and tables, like mini-documents with a wide variety of subjects. I would like to build an application where the user enters a keyword and the macro (after attaching the special building block template to the active document) searches through the custom BBs and presents the name of those entries which contain the search term. I have searched the Internet and can't find any way to search within a BB collection, so I'm assuming that this is not a capability that is built in to Word.

Anyone have any idea how to do this? I suppose I could use Greg Maxey's excellent method of copying the contents of a BB into a temporary (hidden) word document, selecting all the contents of that hidden document and search for the term, and, if found, add the name of that BB to a listbox on a userform, then select all the contents of that hidden document, delete it, and repeat, over and over again, until all the custom BBs have been processed. I would imagine this will take some time depending on the number of BBs in the collection.

Does anyone have any thoughts on using this or an alternate method? I will take a stab at programming it, just wanted some advice.

Thank you.

[gmaxey]

You might be able to leverage the BB.value property:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 12/13/2018
Dim oTmp As Template
Dim strTestText As String
Dim lngIndex As Long
Dim oBB As BuildingBlock
  strTestText = "Dear "
  Set oTmp = ThisDocument.AttachedTemplate
  For lngIndex = 1 To oTmp.BuildingBlockEntries.Count
    Set oBB = oTmp.BuildingBlockEntries(lngIndex)
    If InStr(oBB.Value, strTestText) > 0 Then
      Debug.Print oBB.Name
    End If
  Next lngIndex
lbl_Exit:
  Set oBB = Nothing: Set oTmp = Nothing
  Exit Sub
End Sub

[dbowlds]

Hi Greg,
This is great. Unfortunately, it appears there is a limit to the .value of around 218 characters or so (I suspect it is limited to 255 characters as the Word statistics is ignoring the spaces). So, if the building block is larger than 218 (255?) characters the search string is not found.

[gmaxey]

Yes, I didn't consider that. You might be able to process the short ones that way and any that value returns over say 200 then paste them to a temp document and check the slow way.

[dbowlds]

That works. Thanks much Greg!

[gmaxey]

You're welcome. Why don't you post the working code here for the benefit of other's looking to do something similar. I suppose I could go off and find it, but I for one have forgotten about Greg Maxey's excellent method.

[dbowlds]

I will once I code it.
One thing I've not yet tested, however, is if Word thinks the length of a building block is 255 for all BBs that exceed 255. In other words, I can have Word do the InStr on the .value of the BB if the length of the BB is 255 or less, and then do the manual paste into a temp document method for those BBs exceeding 255 in length. I've just not yet tested if Word knows the actual length of BB .values when they are >255. If not, I'll have to resort to a conducting the manual method for all BBs in the collection. I will report on my findings later.

[dbowlds]

Update: I tested this out, and this is unfortunately what I found (note each of these BB entries are "Quick Part" types):

1. If a BB entry is less than 255, Word properly reports the len(BB.value) as the correct length.
2. If a BB entry is greater than 255, Word reports the len(BB.value) of 255.
3. Now for the really interesting thing I learned: If your BB entry is a text box, then Word reports the len(BB.value) as 1 and Word displays the value as "*" And it seems the InStr function of such a BB.value won't find any search term, even if the term is within the first 255 characters of the text box.

[gmaxey]

Yes that is a conundrum. I can't think of anything else. Unfortunately the process of searching all the BBs may be too time consuming to work. Sorry.

[dbowlds]

Hi Greg, I ended up creating two command buttons on the userform. The first is for a "quick search" and searches the 1st 255 characters of two of the three building block collections, plus a complete search of the 3rd BB collection (which is comprised of nothing but text boxes). The 2nd command button is called "deep search" and does it the slow way, inserting each BB, one by one, into the hidden temp document, searches for the search string, noting finds, and then processing the next BB collection. It turns out the deep scan is not too painfully slow, although as we add more and more BBs to the three collections, this may change.
Thanks for all your help on this.
Doug

[gmaxey]

Doug,

Thanks for the update. Again, please post some code when you get is worked out.

[dbowlds]

Here is the resultant code. Sorry this took so long to post, got swamped with the holidays and all.
This first subroutine provides a "quick" search for the building blocks (searches the first 255 characters).
i have two BB collections to search. The first is just a bunch of text/graphics BB entries. The second, however, is comprised of nothing but text boxes with text inside.
I discovered that if your building block is comprised of text boxes, the BB.value will always come up with an asterisk as the results. So, you will see that the 2nd collection is processed differently than the first. I also have an additional subroutine which performs a "deep" search in that it opens each BB and pastes them one at a time in a temporary document and conducts the search before proceeding onto the next BB. The deep search, of course, takes longer than the quick one.
Regards,
Doug

Private Sub cmdQuickSearch_Click()
    'Note, this only searches the first 255 characters in each building block entry (.value limitation of Word)
    'first, check that there is a term or phrase to search
    If Len(txtSearch.Text) = 0 Then Exit Sub
   
    'next, clear the listboxes
    lbONE.Clear
    lbTWO.Clear
   
    Dim myPath As String, myBBName As String, strTestText As String, myCategory As String
    Dim myIndex As Long
 
    strTestText = LCase(txtSearch.Text)
   
    'process the 1st BB collection
    'note the myBB.value will only work on the first 255 characters (counting spaces, etc.) of the BB
    myPath = "C:\Templates\BBsONE.dotx"
    ActiveDocument.AttachedTemplate = myPath
    Set myTemplate = Templates(myPath)
 
    For myIndex = 1 To myTemplate.BuildingBlockEntries.Count
        Set myBB = myTemplate.BuildingBlockEntries(myIndex)
        If InStr(LCase(myBB.value), strTestText) > 0 Then lbONE.AddItem myBB.name
    Next myIndex
 
    'process the 2nd BB collection
    'have to process this collection differently because this collection is comprised of text boxes and the search within .value will
    'always come up blank (.value will always = "*")
      
    myPath = "C:\Templates\BBsTWO.dotx"
    ActiveDocument.AttachedTemplate = myPath
    Set myTemplate = Templates(myPath)
   
    Dim oTmpDoc As Document
    Set oTmpDoc = Documents.Add(, , , False)
    Dim myShape As Shape
    Dim myTempString As String
   
    For myIndex = 1 To myTemplate.BuildingBlockEntries.Count
        Set myBB = myTemplate.BuildingBlockTypes(wdTypeQuickParts).Categories("Special Text Box").BuildingBlocks(myIndex)
        'Selection.HomeKey Unit:=wdStory
        myBB.Insert oTmpDoc.range
        For Each myShape In oTmpDoc.Shapes
            If myShape.Type = msoTextBox Then
                myShape.Select
                Selection.ShapeRange.TextFrame.TextRange.Select
                myTempString = Selection.Text
                If InStr(LCase(myTempString), strTestText) Then lbTWO.AddItem myBB.name
            End If
        Next
        oTmpDoc.range.Cut
    Next myIndex
    oTmpDoc.Close wdDoNotSaveChanges
 
lbl_Exit:
  Set myBB = Nothing: Set myTemplate = Nothing
End Sub

[dbowlds]

And here is the code for the "deep" search. The part of the code that creates a temporary document and pastes the BB and searches the BB for the search text is derived from code posted by Mr. Greg Maxey on this forum or elsewhere (I cannot remember exactly where).

Private Sub cmdDeepSearch_Click()
    'first, check that there is a term or phrase to search
    If Len(txtSearch.Text) = 0 Then Exit Sub
   
    'next, clear the listbox
    lbONE.Clear
   
    Dim myPath As String, myBBName As String, strTestText As String, myCategory As String
    Dim myIndex As Long
   
    'Create a temp document to store the BBs, one at a time, to search
    Dim oTmpDoc As Document
    Set oTmpDoc = Documents.Add(, , , False)
 
    strTestText = LCase(txtSearch.Text)
    Application.ScreenUpdating = False
   
    'process the 1st BB collection
    myPath = "C:\Templates\BBsONE.dotx"
    ActiveDocument.AttachedTemplate = myPath
    Set myTemplate = Templates(myPath)
   
    For myIndex = 1 To myTemplate.BuildingBlockEntries.Count
        Set myBB = myTemplate.BuildingBlockEntries(myIndex)
        myBB.Insert oTmpDoc.range   'Insert the BB
        Selection.HomeKey unit:=wdStory
        oTmpDoc.range.Select
        With Selection.Find
            .ClearFormatting
            .Text = strTestText
        End With
        If Selection.Find.Execute Then lbONE.AddItem myBB.name
        oTmpDoc.range.Cut   'delete the pasted BB
    Next myIndex
    oTmpDoc.Close wdDoNotSaveChanges
    Application.ScreenUpdating = True
lbl_Exit:
  Set myBB = Nothing: Set myTemplate = Nothing
End Sub

[gmaxey]

As a more general approach, I suppose that I would do it something like this:

Option Explicit
Private Sub cmdSearch_Click()
Dim oTemplate As Template
Dim oBB As BuildingBlock
Dim lngIndex As Long
Dim oTmpDoc As Document
Dim strSearch As String
Dim oShp As Shape
  lstFoundBBs.Clear
  strSearch = LCase(txtSearch.Text)
  Set oTemplate = ThisDocument.AttachedTemplate
  For lngIndex = 1 To oTemplate.BuildingBlockEntries.Count
    Set oBB = oTemplate.BuildingBlockEntries(lngIndex)
    Select Case True
      Case oBB.Value = "*" Or Len(oBB.Value) > 254
        If oTmpDoc Is Nothing Then Set oTmpDoc = Documents.Add(, , , False)
        oBB.Insert oTmpDoc.Range
        If InStr(LCase(oTmpDoc.Range.Text), strSearch) > 0 Then
          With lstFoundBBs
            .AddItem
            .List(.ListCount - 1, 0) = oBB.Name
            .List(.ListCount - 1, 1) = oBB.Description
            .List(.ListCount - 1, 2) = oBB.Type.Index
            .List(.ListCount - 1, 3) = oBB.Category.Name
            .List(.ListCount - 1, 4) = oBB.InsertOptions
          End With
        Else
          For Each oShp In oTmpDoc.Shapes
             If InStr(LCase(oShp.TextFrame.TextRange.Text), LCase(strSearch)) > 0 Then
               With lstFoundBBs
                 .AddItem
                 .List(.ListCount - 1, 0) = oBB.Name
                 .List(.ListCount - 1, 1) = oBB.Description
                 .List(.ListCount - 1, 2) = oBB.Type.Index
                 .List(.ListCount - 1, 3) = oBB.Category.Name
                 .List(.ListCount - 1, 4) = oBB.InsertOptions
               End With
              End If
              Exit For
          Next
        End If
        oTmpDoc.Range.Cut
      Case Else
        If InStr(LCase(oBB.Value), strSearch) > 0 Then
          With lstFoundBBs
            .AddItem
            .List(.ListCount - 1, 0) = oBB.Name
            .List(.ListCount - 1, 1) = oBB.Description
            .List(.ListCount - 1, 2) = oBB.Type.Index
            .List(.ListCount - 1, 3) = oBB.Category.Name
            .List(.ListCount - 1, 4) = oBB.InsertOptions
          End With
        End If
    End Select
  Next lngIndex
  If Not oTmpDoc Is Nothing Then oTmpDoc.Close wdDoNotSaveChanges
lbl_Exit:
  Set oBB = Nothing: Set oTemplate = Nothing
  Exit Sub
End Sub

Private Sub cmdInsert_Click()
  ActiveDocument.AttachedTemplate.BuildingBlockTypes(lstFoundBBs.List(lstFoundBBs.ListIndex, 2)) _
                                 .Categories(lstFoundBBs.List(lstFoundBBs.ListIndex, 3)) _
                                 .BuildingBlocks(lstFoundBBs.List(lstFoundBBs.ListIndex, 0)).Insert _
                                 Where:=Selection.Range, RichText:=True
  Unload Me
End Sub

[gmaxey]

Actually this has developed into a fairly interesting project. I'll post a template when I finish. By adding a few checkboxes you can define a scope and filter the find to match case or match whole word:

Option Explicit
Private strSearch As String
Private oTmpDoc As Document
Private lngCompare As Long

Private Sub UserForm_Initialize()
  If Val(Application.Version) > 14 Then
    Width = 232
  Else
    Width = 225
  End If
  lstFoundBBs.AddItem "...Pending Search..."
  cmdInsert.Enabled = False
  cmdInsertandClose.Enabled = False
  cmdSearch.Enabled = False
lbl_Exit:
  Exit Sub

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If CloseMode = 0 Then
    Cancel = False
    cmdCancel_Click
  End If
lbl_Exit:
  Exit Sub
End Sub

Private Sub cmdSearch_Click()
Dim oTemplate As Template

  lstFoundBBs.Clear
  lngCompare = 1
  If chkMatchCase Then lngCompare = 0
  If chkBI Then Templates.LoadBuildingBlocks
  If chkAll Then
    For Each oTemplate In Templates
      With lstTemplates
        .AddItem
        .List(.ListCount - 1, 0) = oTemplate.FullName
      End With
    Next
  End If
  With lblFound
    .Caption = "Building list ... please wait"
    .ForeColor = &HC000&
  End With
  Repaint
  strSearch = txtSearch.Text
  Select Case True
    Case chkAll
      For Each oTemplate In Templates
        BuildList oTemplate
        Set oTemplate = Nothing
      Next oTemplate
    Case Else
      If chkNormal Then
        Set oTemplate = NormalTemplate
        BuildList oTemplate
        Set oTemplate = Nothing
      End If
      If chkBI Then
        For Each oTemplate In Templates
          If oTemplate.Name = "Built-In Building Blocks.dotx" Then Exit For
        Next oTemplate
        If Not oTemplate Is Nothing Then
          BuildList oTemplate
          Set oTemplate = Nothing
        End If
      End If
      If chkAttached Then
        Set oTemplate = ThisDocument.AttachedTemplate
        BuildList oTemplate
        Set oTemplate = Nothing
      End If
  End Select
  With lblFound
    If lstFoundBBs.ListCount > 0 Then
      .Caption = "Found Blocks w\Name and Description (if defined)"
    Else
      .Caption = "Nothing found"
    End If
    .ForeColor = &H80000012
  End With
lbl_Exit:
  Set oTemplate = Nothing
  Exit Sub
End Sub

Private Sub cmdInsert_Click()
Dim oTemplate As Template
  Set oTemplate = Templates(lstFoundBBs.List(lstFoundBBs.ListCount - 1, 5))
  oTemplate.BuildingBlockTypes(lstFoundBBs.List(lstFoundBBs.ListIndex, 2)) _
           .Categories(lstFoundBBs.List(lstFoundBBs.ListIndex, 3)) _
           .BuildingBlocks(lstFoundBBs.List(lstFoundBBs.ListIndex, 0)).Insert _
           Where:=Selection.Range, RichText:=True
lbl_Exit:
  Set oTemplate = Nothing
End Sub
Private Sub cmdInsertAndClose_Click()
Dim oTemplate As Template
  Set oTemplate = Templates(lstFoundBBs.List(lstFoundBBs.ListCount - 1, 5))
  oTemplate.BuildingBlockTypes(lstFoundBBs.List(lstFoundBBs.ListIndex, 2)) _
           .Categories(lstFoundBBs.List(lstFoundBBs.ListIndex, 3)) _
           .BuildingBlocks(lstFoundBBs.List(lstFoundBBs.ListIndex, 0)).Insert _
           Where:=Selection.Range, RichText:=True
lbl_Exit:
  Set oTemplate = Nothing
  cmdCancel_Click
End Sub

Private Sub cmdCancel_Click()
  If Not oTmpDoc Is Nothing Then oTmpDoc.Close wdDoNotSaveChanges
  Unload Me
lbl_Exit:
  Exit Sub
End Sub

Private Sub lstFoundBBs_Click()
  If lstFoundBBs.ListIndex <> -1 Then
    cmdInsert.Enabled = True
  Else
    cmdInsert.Enabled = False
  End If
lbl_Exit:
  Exit Sub
End Sub

Private Sub txtSearch_Change()
  cmdInsert.Enabled = False
  cmdSearch.Enabled = True
  If txtSearch.Text = vbNullString Then cmdSearch.Enabled = False
  With lstFoundBBs
    .Clear
    .AddItem "...Pending Search..."
  End With
  lblFound.Caption = "Select found building block and click Insert"
lbl_Exit:
  Exit Sub
End Sub




Private Sub chkNormal_Change()
  txtSearch_Change
lbl_Exit:
  Exit Sub
End Sub

Private Sub chkBI_Change()
  txtSearch_Change
lbl_Exit:
  Exit Sub
End Sub

Private Sub chkAttached_Change()
  txtSearch_Change
lbl_Exit:
  Exit Sub
End Sub

Private Sub All_Change()
  txtSearch_Change
lbl_Exit:
  Exit Sub
End Sub

Private Sub chkMatchCase_Change()
  txtSearch_Change
lbl_Exit:
  Exit Sub
End Sub

Private Sub chkMWW_Change()
  txtSearch_Change
lbl_Exit:
  Exit Sub
End Sub

Private Sub chkShapeRanges_Change()
  txtSearch_Change
lbl_Exit:
  Exit Sub
End Sub
Sub BuildList(TemplatePassed As Template)
Dim lngIndex As Long
Dim oBB As BuildingBlock
Dim oRng As Range
Dim oShp As Shape
  For lngIndex = 1 To TemplatePassed.BuildingBlockEntries.Count
    Set oBB = TemplatePassed.BuildingBlockEntries(lngIndex)
    Select Case True
      Case oBB.Value = "*" Or oBB.Value Like "[*]*" Or Len(oBB.Value) > 254
       
        If oTmpDoc Is Nothing Then Set oTmpDoc = Documents.Add(, , , False)
        oBB.Insert oTmpDoc.Range
        If InStr(1, oTmpDoc.Range.Text, strSearch, lngCompare) > 0 Then
          If Not chkMWW Then
            With lstFoundBBs
              .AddItem
              .List(.ListCount - 1, 0) = oBB.Name
              .List(.ListCount - 1, 1) = oBB.Description
              .List(.ListCount - 1, 2) = oBB.Type.Index
              .List(.ListCount - 1, 3) = oBB.Category.Name
              .List(.ListCount - 1, 4) = oBB.InsertOptions
              .List(.ListCount - 1, 5) = TemplatePassed.FullName
            End With
          Else
            Set oRng = oTmpDoc.Range
            With oRng.Find
              .Text = strSearch
              .MatchCase = chkMatchCase
              .MatchWholeWord = True
              If .Execute Then
                With lstFoundBBs
                  .AddItem
                  .List(.ListCount - 1, 0) = oBB.Name
                  .List(.ListCount - 1, 1) = oBB.Description
                  .List(.ListCount - 1, 2) = oBB.Type.Index
                  .List(.ListCount - 1, 3) = oBB.Category.Name
                  .List(.ListCount - 1, 4) = oBB.InsertOptions
                  .List(.ListCount - 1, 5) = TemplatePassed.FullName
                End With
              End If
            End With
          End If
        Else
          If chkShapeRanges Then
            For Each oShp In oTmpDoc.Shapes
              If fcnEvalShapeText(oShp) Then
                With lstFoundBBs
                  .AddItem
                  .List(.ListCount - 1, 0) = oBB.Name
                  .List(.ListCount - 1, 1) = oBB.Description
                  .List(.ListCount - 1, 2) = oBB.Type.Index
                  .List(.ListCount - 1, 3) = oBB.Category.Name
                  .List(.ListCount - 1, 4) = oBB.InsertOptions
                  .List(.ListCount - 1, 5) = TemplatePassed.FullName
                End With
                Exit For
              End If
            Next
          End If
        End If
        oTmpDoc.Range.Cut
      Case Else
        If InStr(1, oBB.Value, strSearch, lngCompare) > 0 Then
          If Not chkMWW Then
            With lstFoundBBs
              .AddItem
              .List(.ListCount - 1, 0) = oBB.Name
              .List(.ListCount - 1, 1) = oBB.Description
              .List(.ListCount - 1, 2) = oBB.Type.Index
              .List(.ListCount - 1, 3) = oBB.Category.Name
              .List(.ListCount - 1, 4) = oBB.InsertOptions
              .List(.ListCount - 1, 5) = TemplatePassed.FullName
            End With
          Else
            If oTmpDoc Is Nothing Then Set oTmpDoc = Documents.Add(, , , False)
            oBB.Insert oTmpDoc.Range
            Set oRng = oTmpDoc.Range
            With oRng.Find
              .Text = strSearch
              .MatchCase = chkMatchCase
              .MatchWholeWord = True
              If .Execute Then
                With lstFoundBBs
                  .AddItem
                  .List(.ListCount - 1, 0) = oBB.Name
                  .List(.ListCount - 1, 1) = oBB.Description
                  .List(.ListCount - 1, 2) = oBB.Type.Index
                  .List(.ListCount - 1, 3) = oBB.Category.Name
                  .List(.ListCount - 1, 4) = oBB.InsertOptions
                  .List(.ListCount - 1, 5) = TemplatePassed.FullName
                End With
              End If
            End With
          End If
        End If
     End Select
  Next lngIndex
  Set oBB = Nothing: Set TemplatePassed = Nothing
End Sub


Function fcnEvalShapeText(oShp As Shape) As Boolean
Dim oRng As Range
Dim oPar As Paragraph
  fcnEvalShapeText = False
  If Not chkMWW Then
    On Error Resume Next
    If InStr(1, oShp.TextFrame.TextRange.Text, strSearch, lngCompare) > 0 Then
      If Err.Number = 0 Then
        fcnEvalShapeText = True
      Else
        Err.Clear
        If InStr(1, oShp.AlternativeText, strSearch, lngCompare) > 0 Then
          If Err.Number = 0 Then
            fcnEvalShapeText = True
          End If
        End If
      End If
      On Error GoTo 0
    End If
  Else
    On Error Resume Next
    If InStr(1, oShp.TextFrame.TextRange.Text, strSearch, lngCompare) > 0 Then
      If Err.Number = 0 Then
        Set oRng = oShp.TextFrame.TextRange
        With oRng.Find
          .Text = strSearch
          .MatchCase = chkMatchCase
          .MatchWholeWord = True
          If .Execute Then fcnEvalShapeText = True
        End With
      Else
        Err.Clear
        If InStr(1, oShp.AlternativeText, strSearch, lngCompare) > 0 Then
          If Err.Number = 0 Then
            Set oRng = oShp.Parent.Range
            oRng.Collapse wdCollapseEnd
            oRng.InsertBefore vbCr
            Set oPar = oRng.Paragraphs.Last.Previous
            oPar.Range.Text = oShp.AlternativeText
            With oPar.Range.Find
              .Text = strSearch
              .MatchCase = chkMatchCase
              .MatchWholeWord = True
              If .Execute Then fcnEvalShapeText = True
            End With
            oPar.Range.Delete
          End If
        End If
      End If
      On Error GoTo 0
    End If
  
  End If
lbl_Exit:
  Exit Function
End Function

[gmaxey]

The file is attached. I couldn't upload the .dotm with some example BBs but just save the attached as .dotom and add you own text examples.

[dbowlds]

Oh my! I am going to set aside some time to study this. I will get back to you.

[dbowlds]

Hi Greg. I finally had a chance to play with this and - wow! It works pretty darn good! I saved the .docm and put my three custom BB templates in the custom office templates folder and loaded them and ran the program (thanks for putting the command bar macro there and making it simple for me!). It worked great! I experimented with attaching different custom templates and playing around with the various options buttons you provided (which provided some great versatility I might add) and for the most part it worked flawlessly, including inserting the BB via the different insertion methods. I also checked that the program was not consuming multiple instances of Word as confirmed via Task Manager. I have discovered the hard way that playing around with various methods of temporarily adding documents and pasting temporary BBs from various templates (attaching and detaching them as I go, etc.) easily can result in multiple instances of Word staying open in Word (2016) long after you've closed all apparent instances of Word. Something I've learned to always check after I create a new module - whether or not Word is closing properly and releasing the memory back to the system upon exit. Your code this is just fine.
I had to change the column settings in the userform for the lstFoundBBs to get some of the columns (like Category and insert method, etc.) to display. But this tool is awesome! I can't say I fully understand all the code but have a general understanding of what you are doing and really appreciate all the effort you put into this project!
You are the best!!!
Doug

[gmaxey]

I've polished this process a bit further and added the ability to wildcard search plus scope search to specific gallery\galleries. You can download it here:
https://gregmaxey.com/word_tip_pages...ch_insert.html