Исходный текст

Option Explicit
Call EraseTestAttribute(ThisApplication.Shell.SelObjects)


'==============================================================================
' Удалить тестовый аттрибут
'==============================================================================
Sub EraseTestAttribute(ObjCol)
    Dim obj, attr, ACol
        With ObjCol
        'Если нет информации об объектах, выйти из процедуры
            If .Count = 0 Then 
                    MsgBox "Объекты отсутствуют.", _
                            vbInformation, "Информация о текущей настройке"
                    Exit Sub
            End If
        End With    
    
    'Получить коллекцию атрибутов объекта
    Set obj = ObjCol(0)
    Set ACol = Obj.Attributes
    
    'Если коллекция атрибутов пустая, закончить работу
    If ACol.Count = 0 Then
        MsgBox "Объект """ & Obj.Description & """ не имеет атрибутов.", vbInformation
        Exit Sub
    End If
    
    
    On Error Resume Next
        With ACol    
            testdesc = "Тестовый аттрибут"
            For i = 0 to .Count - 1
                    if .Item(i).Description = testdesc Then
                        .Item(i).Erase
                    End If
            Next
                
            'Если ошибка, то в системе присутвуют ссылки на дыннй атрибут, удалить его невозможно.
            If Err<>0 Then
                    MsgBox "Ошибка удаления объектов" _
                                & Chr(13) &    "Код ошибки: " & Err, vbExclamation     
            End If
        End With    
End Sub 
'==============================================================================