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
iItemsUpdated = 0
For Each aItem In calendar.Items
If Mid(aItem.Subject, 1, 10) = „Kopieren: “ Then
strTemp = Mid(aItem.Subject, 11, Len(aItem.Subject) – 10)
aItem.Subject = strTemp
iItemsUpdated = iItemsUpdated + 1
End If
aItem.Save
Next aItem
MsgBox iItemsUpdated & “ of “ & calendar.Items.Count & “ Meetings Updated“
End Sub
