How to Delete Embedded Excel Objects in VBA

I wanted to do a bulk delete of embedded chemical structures in a series of Excel workbooks, without touching embedded graphs and data tables. Here's the resulting VBA code. You should be able to easily modify this to delete any custom object types in an Excel workbook.

Sub WipeObjects
' Delete all current embedded chemical structures from currently open Excel workbook
' Example sub to call ChemObjectWipe function
    MsgBox ChemObjectWipe()
End Sub

Function ChemObjectWipe() As String
    Dim currSheet As Worksheet
    Dim itemnum As Long
    For Each currSheet In ActiveWorkbook.Sheets
        Dim structures As New Collection
        Dim embeddedItems As OLEObjects
        Dim shp As OLEObject
        Dim deleteStatus As String
        Dim creator, currName As String
        Set embeddedItems = currSheet.OLEObjects
        If (embeddedItems.Count > 0) Then
        For Each shp In embeddedItems
            currName = ""
            creator = ""
            currName = shp.Name
            creator = UCase(shp.progID)
'            MsgBox currName & creator & " item number "
            deleteStatus = ""
' Return value
            ChemObjectWipe = ChemObjectWipe & currName & "::" & creator
' Change substrings here to match different object creators
            If ((InStr(creator, "ISIS") <> 0) Or (InStr(creator, "CHEM") <> 0) Or (InStr(creator, "MDL") <> 0)) Then
'                MsgBox "Adding to delete queue " & creator & "::" & currName
                ChemObjectWipe = ChemObjectWipe & "(ERASED)"
                structures.Add (currName)
            End If
            ChemObjectWipe = ChemObjectWipe & ";"
        Next shp
'        MsgBox "Count = " & Str(structures.Count)
        For itemnum = 1 To structures.Count
            embeddedItems(structures.Item(itemnum)).Delete
        Next itemnum
        End If
    Next currSheet
End Function