For a different way of approaching the problem, try something along the lines of:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim StrOut As String
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.Font.Bold = True
.MatchWildcards = False
.Execute
End With
Do While .Find.Found
StrOut = StrOut & vbCr & .Text
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
While InStr(StrOut, vbCr & vbCr) > 0
StrOut = Replace(StrOut, vbCr & vbCr, vbCr)
Wend
Application.ScreenUpdating = True
MsgBox "The document contains the following bold text:" & StrOut
End Sub