Sub RemoveCopy()

    Dim myolApp As Outlook.Application
    Dim calendar As MAPIFolder
    Dim aItem As Object

    Set myolApp = CreateObject("Outlook.Application")
    Set calendar = myolApp.ActiveExplorer.CurrentFolder

    Dim iItemsUpdated As Integer
    Dim strTemp As String
    Dim strSearch As String
    Dim iSearch As Integer
    
    ' Nach diesem Prefix (Kopieren: ) wird in den Kalendereinträgen gesucht
    strSearch = "Kopieren: "
    iSearch = Len(strSearch)
    
    iItemsUpdated = 0
    For Each aItem In calendar.Items
        If Mid(aItem.Subject, 1, iSearch) = strSearch Then
          strTemp = Mid(aItem.Subject, (iSearch + 1), Len(aItem.Subject) - iSearch)
          aItem.Subject = strTemp
          iItemsUpdated = iItemsUpdated + 1
        End If
        aItem.Save
    Next aItem
    
    MsgBox iItemsUpdated & " von " & calendar.Items.Count & " Kalendareinträgen korrigiert"

End Sub