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. :yes
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.:thumb
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 :doh: and Word displays the value as "*" :doh: 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(lstFoun dBBs.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. :yes

[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. :thumb
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/buildingblocks_search_insert.html