Extracting Specific Attributes

Hello to Discussion Group Members:

I have been using a "VBA" routine that extracts all attributes on a drawing into an Excel spreedsheet.

However, I would like to try and modify this routine to extract only specific attributes (where I know the block name) into the Excel sheet, but I am having a problem accomplishing this task.

Below is a portion of the code that uses the GetAttribute method. Can anyone help me with a solution that will look for the attributes of specific blocks only...?

CODE START:

Set doc = acad.ActiveDocument
Set mspace = doc.ModelSpace
RowNum = 1
Dim Header As Boolean
Header = False
For Each elem In mspace
With elem
If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
If .HasAttributes Then
Array1 = .GetAttributes
For Count = LBound(Array1) To UBound(Array1)
If Header = False Then
If StrComp(Array1(Count).EntityName, "AcDbAttribute", 1) = 0 Then
excelSheet.Cells(RowNum, Count + 1).Value = Array1(Count).TagString
End If
End If
Next Count
RowNum = RowNum + 1
For Count = LBound(Array1) To UBound(Array1)
excelSheet.Cells(RowNum, Count + 1).Value = Array1(Count).TextString
Next Count
Header = True
End If
End If
End With
Next elem
NumberOfAttributes = RowNum - 1
If NumberOfAttributes > 0 Then
Worksheets("Attributes").Range("A1").Sort _
key1:=Worksheets("Attributes").Columns("A"), _
Header:=xlGuess
Else
MsgBox "No attributes found in the current drawing"
End If
Set acad = Nothing
End Sub

CODE END:

Any assistance with this would be appreciated.

Regards,
Vince