Set doc = collection.GetFirstDocument
While Not (doc Is Nothing)
Set rtitem = doc.GetFirstItem( "Body" )
If ( rtitem.Type = RICHTEXT ) Then
If Isarray( rtitem.embeddedObjects) Then
Forall o In rtitem.EmbeddedObjects
Call o.Remove
Call doc.Save( False, True )
End Forall
Else
Msgbox "is nicht"
End If
End If
Set doc = collection.GetNextDocument(doc)
Wend
Msgbox "Anhang / Anhänge gelöscht"
End If
End Sub