Outlook 2013 Kalendereintrag per Regel akzeptieren und löschen
speedy132 (Level 1) - Jetzt verbinden
24.04.2017, aktualisiert 14:29 Uhr, 1454 Aufrufe, 27 Kommentare
Hallo,
ich möchte das bestimmte Kalendereinträge automatisiert z. B. durch eine Regel akzeptiert werden.
Zur Erklärung:
Wir haben folgendes Szenario.
Einzelne Mitarbeiter übernehmen für bestimmte Kunden den Support. Das wird in ein Excel File eingetragen und in SAP verarbeitet.
Soweit so gut....
Jetzt hat ein Mitarbeiter aber z.B. 10 Kunden für die er Support übernimmt und bekommt dann von SAP eine automatisch generierte Email zugeschickt (Die Order Nummer ist im Betreff enthalten), wo
der entsprechende Zeitraum für den Kalender aufgeführt ist.
Pro Kunde eine Mail. Jetzt hast du wie gesagt 10 Kunden und bekommst dann 10 Kalendereinträge per Mail zugeschickt und musst diese dann entsprechend öffnen und speichern, damit der Eintrag im Kalender übernommen wird. Das ganze aber auch, wenn sich kurzfristig etwas ändert oder der Eintrag gelöscht wird, da ich z.B. den Support abgebeben habe.
Sehr lästig und nervig.
Meine Überlegung ist, eine Regel zu erstellen, die automatisch den Kalendereintrag akzeptiert und die Mail dann löscht.
Bei Absage bzw. Austrag aus dem Kalender dasselbe. Eine Regel die automatisch den Kalendereintrag löscht.
Dazu habe ich in den Regeln aber keinen Eintrag gefunden.
Kann ich so eine Regel selbst erstellen (evtl. vba)?
Über jeden Hinweis etc. bin ich dankbar.
Schon mal herzlichen Dank
Gruß
Marcus
ich möchte das bestimmte Kalendereinträge automatisiert z. B. durch eine Regel akzeptiert werden.
Zur Erklärung:
Wir haben folgendes Szenario.
Einzelne Mitarbeiter übernehmen für bestimmte Kunden den Support. Das wird in ein Excel File eingetragen und in SAP verarbeitet.
Soweit so gut....
Jetzt hat ein Mitarbeiter aber z.B. 10 Kunden für die er Support übernimmt und bekommt dann von SAP eine automatisch generierte Email zugeschickt (Die Order Nummer ist im Betreff enthalten), wo
der entsprechende Zeitraum für den Kalender aufgeführt ist.
Pro Kunde eine Mail. Jetzt hast du wie gesagt 10 Kunden und bekommst dann 10 Kalendereinträge per Mail zugeschickt und musst diese dann entsprechend öffnen und speichern, damit der Eintrag im Kalender übernommen wird. Das ganze aber auch, wenn sich kurzfristig etwas ändert oder der Eintrag gelöscht wird, da ich z.B. den Support abgebeben habe.
Sehr lästig und nervig.
Meine Überlegung ist, eine Regel zu erstellen, die automatisch den Kalendereintrag akzeptiert und die Mail dann löscht.
Bei Absage bzw. Austrag aus dem Kalender dasselbe. Eine Regel die automatisch den Kalendereintrag löscht.
Dazu habe ich in den Regeln aber keinen Eintrag gefunden.
Kann ich so eine Regel selbst erstellen (evtl. vba)?
Über jeden Hinweis etc. bin ich dankbar.
Schon mal herzlichen Dank
Gruß
Marcus
27 Antworten
- LÖSUNG 132895 schreibt am 24.04.2017 um 17:23:33 Uhr
- LÖSUNG speedy132 schreibt am 25.04.2017 um 08:58:18 Uhr
- LÖSUNG 132895 schreibt am 25.04.2017 um 09:25:59 Uhr
- LÖSUNG speedy132 schreibt am 25.04.2017 um 10:15:45 Uhr
- LÖSUNG 132895 schreibt am 25.04.2017 um 10:20:18 Uhr
- LÖSUNG speedy132 schreibt am 25.04.2017 um 10:50:59 Uhr
- LÖSUNG 132895 schreibt am 25.04.2017 um 10:51:47 Uhr
- LÖSUNG speedy132 schreibt am 25.04.2017 um 10:58:34 Uhr
- LÖSUNG 132895 schreibt am 25.04.2017 um 11:21:05 Uhr
- LÖSUNG speedy132 schreibt am 25.04.2017 um 12:14:13 Uhr
- LÖSUNG 132895 schreibt am 25.04.2017 um 12:19:20 Uhr
- LÖSUNG speedy132 schreibt am 27.04.2017 um 10:31:39 Uhr
- LÖSUNG 132895 schreibt am 27.04.2017 um 10:37:32 Uhr
- LÖSUNG speedy132 schreibt am 27.04.2017 um 11:31:42 Uhr
- LÖSUNG 132895 schreibt am 27.04.2017 um 11:36:12 Uhr
- LÖSUNG speedy132 schreibt am 27.04.2017 um 13:20:07 Uhr
- LÖSUNG 132895 schreibt am 27.04.2017 um 13:40:54 Uhr
- LÖSUNG speedy132 schreibt am 27.04.2017 um 14:17:32 Uhr
- LÖSUNG 132895 schreibt am 27.04.2017 um 14:20:06 Uhr
- LÖSUNG speedy132 schreibt am 27.04.2017 um 14:51:41 Uhr
- LÖSUNG 132895 schreibt am 27.04.2017 um 15:03:52 Uhr
- LÖSUNG speedy132 schreibt am 28.04.2017 um 08:37:05 Uhr
- LÖSUNG 132895 schreibt am 28.04.2017 um 09:33:01 Uhr
- LÖSUNG speedy132 schreibt am 28.04.2017 um 11:22:19 Uhr
- LÖSUNG 132895 schreibt am 28.04.2017 um 11:37:49 Uhr
- LÖSUNG speedy132 schreibt am 28.04.2017 um 14:57:49 Uhr
- LÖSUNG 132895 schreibt am 28.04.2017 um 15:22:26 Uhr
- LÖSUNG speedy132 schreibt am 28.04.2017 um 14:57:49 Uhr
- LÖSUNG 132895 schreibt am 28.04.2017 um 11:37:49 Uhr
- LÖSUNG speedy132 schreibt am 28.04.2017 um 11:22:19 Uhr
- LÖSUNG 132895 schreibt am 28.04.2017 um 09:33:01 Uhr
- LÖSUNG speedy132 schreibt am 28.04.2017 um 08:37:05 Uhr
- LÖSUNG 132895 schreibt am 27.04.2017 um 15:03:52 Uhr
- LÖSUNG speedy132 schreibt am 27.04.2017 um 14:51:41 Uhr
- LÖSUNG 132895 schreibt am 27.04.2017 um 14:20:06 Uhr
- LÖSUNG speedy132 schreibt am 27.04.2017 um 14:17:32 Uhr
- LÖSUNG 132895 schreibt am 27.04.2017 um 13:40:54 Uhr
- LÖSUNG speedy132 schreibt am 27.04.2017 um 13:20:07 Uhr
- LÖSUNG 132895 schreibt am 27.04.2017 um 11:36:12 Uhr
- LÖSUNG speedy132 schreibt am 27.04.2017 um 11:31:42 Uhr
- LÖSUNG 132895 schreibt am 27.04.2017 um 10:37:32 Uhr
- LÖSUNG speedy132 schreibt am 27.04.2017 um 10:31:39 Uhr
- LÖSUNG 132895 schreibt am 25.04.2017 um 12:19:20 Uhr
- LÖSUNG speedy132 schreibt am 25.04.2017 um 12:14:13 Uhr
- LÖSUNG 132895 schreibt am 25.04.2017 um 11:21:05 Uhr
- LÖSUNG speedy132 schreibt am 25.04.2017 um 10:58:34 Uhr
- LÖSUNG 132895 schreibt am 25.04.2017 um 10:51:47 Uhr
- LÖSUNG speedy132 schreibt am 25.04.2017 um 10:50:59 Uhr
- LÖSUNG 132895 schreibt am 25.04.2017 um 10:20:18 Uhr
- LÖSUNG speedy132 schreibt am 25.04.2017 um 10:15:45 Uhr
- LÖSUNG 132895 schreibt am 25.04.2017 um 09:25:59 Uhr
- LÖSUNG speedy132 schreibt am 25.04.2017 um 08:58:18 Uhr
LÖSUNG 24.04.2017, aktualisiert um 17:25 Uhr
Kann ich so eine Regel selbst erstellen (evtl. vba)?
AppointmentItem.Respond Method (Outlook)oder
Ressourcen-Postfach am Exchange mit Buchungsautomatik erstellen?
Gruß
LÖSUNG 25.04.2017 um 08:58 Uhr
Hallo elchapo,
kann nur clientseitig arbeiten, habe zum Server keinen Zugriff.
Die Methode habe ich so übernommen und funktioniert echt super. Genau den Effekt den ich mir vorgestellt habe.
Allerdings werden jetzt alle Terminanfragen sofort eingetragen.
Jetzt müsste im Code noch eine Untersuchung der Betreffzeile stattfinden. Und nur wenn da eine bestimmte Nummer drin steht, dann soll das so gemacht werden.
Das ist die Methode:
Sub AcceptMeeting()
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myMtgReq As Outlook.MeetingItem
Dim myAppt As Outlook.AppointmentItem
Dim myMtg As Outlook.MeetingItem
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myMtgReq = myFolder.Items.Find("[MessageClass] = 'IPM.Schedule.Meeting.Request'")
If TypeName(myMtgReq) <> "Nothing" Then
Set myAppt = myMtgReq.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
myMtg.Send
End If
End Sub
Meine Kenntnisse sind aber nicht so tiefgreifend, um das jetzt hier einbauen zu können.
Gruß
Marcus
kann nur clientseitig arbeiten, habe zum Server keinen Zugriff.
Die Methode habe ich so übernommen und funktioniert echt super. Genau den Effekt den ich mir vorgestellt habe.
Allerdings werden jetzt alle Terminanfragen sofort eingetragen.
Jetzt müsste im Code noch eine Untersuchung der Betreffzeile stattfinden. Und nur wenn da eine bestimmte Nummer drin steht, dann soll das so gemacht werden.
Das ist die Methode:
Sub AcceptMeeting()
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myMtgReq As Outlook.MeetingItem
Dim myAppt As Outlook.AppointmentItem
Dim myMtg As Outlook.MeetingItem
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myMtgReq = myFolder.Items.Find("[MessageClass] = 'IPM.Schedule.Meeting.Request'")
If TypeName(myMtgReq) <> "Nothing" Then
Set myAppt = myMtgReq.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
myMtg.Send
End If
End Sub
Meine Kenntnisse sind aber nicht so tiefgreifend, um das jetzt hier einbauen zu können.
Gruß
Marcus
LÖSUNG 25.04.2017, aktualisiert um 09:28 Uhr
LÖSUNG 25.04.2017 um 10:15 Uhr
LÖSUNG 25.04.2017, aktualisiert um 10:20 Uhr
LÖSUNG 25.04.2017 um 10:50 Uhr
Ich verzweifle fast. Ich tue mich so schwer damit...
So habe ich das jetzt und es funktioniert nicht.
For Each m In myMtgReq
If m.Subject = "test" Then
Set myAppt = myMtgReq.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
myMtg.Send
End If
Next
-> Objekt unterstützt diese Methode ... nicht...
Was mach ich denn noch falsch?
So habe ich das jetzt und es funktioniert nicht.
For Each m In myMtgReq
If m.Subject = "test" Then
Set myAppt = myMtgReq.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
myMtg.Send
End If
Next
-> Objekt unterstützt diese Methode ... nicht...
Was mach ich denn noch falsch?
LÖSUNG 25.04.2017, aktualisiert um 10:54 Uhr
Du hast das m nicht in den anderen Zeilen innerhalb der For-Schleife ersetzt
. Denn in myMtgReq sind mehrere Items die du mit der Schleife durchläufst und dann innerhalb der Schleife "einzeln" mit dem m ansprichst.
Ab und zu sollte man auch Dokus lesen
Das sind einfachste Grundlagen die du überall nachlesen kannst.
Wenn du das nicht willst, fang gar nicht erst das Programmieren an!!
Ab und zu sollte man auch Dokus lesen
Wenn du das nicht willst, fang gar nicht erst das Programmieren an!!
LÖSUNG 25.04.2017 um 10:58 Uhr
LÖSUNG 25.04.2017, aktualisiert um 11:25 Uhr
Aber der Anfang der Schleife ist glaube ich schon fehlerhaft. Muss das m nicht noch deklariert werden?
Musst du nicht wenn du nicht Option Explicit am Anfang des Codes stehen hast Dim myMtgReq As Items
LÖSUNG 25.04.2017 um 12:14 Uhr
LÖSUNG 25.04.2017, aktualisiert um 12:19 Uhr
Zitat von @speedy132:
Allerdings weiß ich auch nicht, wo ich so etwas spezielles in kürzester Zeit nachlesen soll.
In den Grundlagen zu VBA steht's.Allerdings weiß ich auch nicht, wo ich so etwas spezielles in kürzester Zeit nachlesen soll.
Als was muss ich denn dann mymtgReq deklarieren?
Steht oben.LÖSUNG 27.04.2017 um 10:31 Uhr
So, ich habe jetzt ein wenig getestet und probiert und folgendes Ergebnis erzielt:
Sub AcceptMeeting()
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myAppt As Outlook.AppointmentItem
Dim myMtg As Outlook.MeetingItem
Dim myMail As Outlook.MailItem
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myMtgReq = myFolder.Items
If TypeName(myMtgReq) <> "Nothing" Then
For Each m In myMtgReq
'If m.UnRead = True Then
'Neuer Termin
If m.Subject = "I-55023414-:0" Or m.Subject = "I-55023399-:0" Then
Set myAppt = m.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
myMtg.Send
m.UnRead = False
m.Delete
End If
'Für Terminänderungen -> Änderungen U-55… statt I-55… und man muss nicht erneut auf Zusagen klicken
If m.Subject = "U-55023414-:0" Or m.Subject = "U-55023399-:0" Then
Set myAppt = m.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
'myMtg.Send
m.UnRead = False
m.Delete
End If
'End If
Next
End If
End Sub
Funktioniert soweit, allerdings sobald eine Mail mit Termin gefunden wird, wird die Schleife beendet, obwohl noch weitere Termine da sind.
Was kann man da noch verändern?
Gruß
Marcus
Sub AcceptMeeting()
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myAppt As Outlook.AppointmentItem
Dim myMtg As Outlook.MeetingItem
Dim myMail As Outlook.MailItem
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myMtgReq = myFolder.Items
If TypeName(myMtgReq) <> "Nothing" Then
For Each m In myMtgReq
'If m.UnRead = True Then
'Neuer Termin
If m.Subject = "I-55023414-:0" Or m.Subject = "I-55023399-:0" Then
Set myAppt = m.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
myMtg.Send
m.UnRead = False
m.Delete
End If
'Für Terminänderungen -> Änderungen U-55… statt I-55… und man muss nicht erneut auf Zusagen klicken
If m.Subject = "U-55023414-:0" Or m.Subject = "U-55023399-:0" Then
Set myAppt = m.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
'myMtg.Send
m.UnRead = False
m.Delete
End If
'End If
Next
End If
End Sub
Funktioniert soweit, allerdings sobald eine Mail mit Termin gefunden wird, wird die Schleife beendet, obwohl noch weitere Termine da sind.
Was kann man da noch verändern?
Gruß
Marcus
LÖSUNG 27.04.2017, aktualisiert um 10:38 Uhr
Logisch, weil du mit
Speichere die Elemente die gelöscht werden sollen in einer weiteren Collection zwischen und lösche die Elemente der Collection am Ende der Sub. Fertig.
p.s. Schon mal was von Codetags hier im Forum gehört?
</> links in deiner Symbolleiste!!
m.Delete
die Items-Collection in der Schleife veränderst, also Items raus löschst, deswegen werden Elemente übersprungen.Speichere die Elemente die gelöscht werden sollen in einer weiteren Collection zwischen und lösche die Elemente der Collection am Ende der Sub. Fertig.
p.s. Schon mal was von Codetags hier im Forum gehört?
</> links in deiner Symbolleiste!!
LÖSUNG 27.04.2017 um 11:31 Uhr
LÖSUNG 27.04.2017 um 11:36 Uhr
LÖSUNG 27.04.2017 um 13:20 Uhr
LÖSUNG 27.04.2017 um 13:40 Uhr
LÖSUNG 27.04.2017 um 14:17 Uhr
Ja super, damit kann ich diesen Thread als gelöst erklären.
Hier nun meine Implementierung:
Herzlichen Dank an password für die Hilfestellung 
Hier nun meine Implementierung:
Sub AcceptMeeting()
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myAppt As Outlook.AppointmentItem
Dim myMtg As Outlook.MeetingItem
Dim myCol As Collection
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myMtgReq = myFolder.Items
Set myCol = New Collection
If TypeName(myMtgReq) <> "Nothing" Then
For Each m In myMtgReq
If m.Subject = "I-55023414-:0" Or m.Subject = "I-55023399-:0" Then
Set myAppt = m.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
myMtg.Send
m.UnRead = False
myCol.Add m
End If
If m.Subject = "U-55023414-:0" Or m.Subject = "U-55023399-:0" Then
Set myAppt = m.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
m.UnRead = False
myCol.Add m
End If
Next
If myCol.Count >= 1 Then
For Each element In myCol
element.Delete
Next
End If
End If
Set myCol = Nothing
End Sub
LÖSUNG 27.04.2017, aktualisiert um 14:23 Uhr
LÖSUNG 27.04.2017 um 14:51 Uhr
LÖSUNG 27.04.2017, aktualisiert um 15:05 Uhr
Zitat von @speedy132:
Ja, das hat mich aber auch Nerven und Zeit gekostet. Aber das Ergebnis ist prima.
Und du hast vor allem auch was gelernt.Ja, das hat mich aber auch Nerven und Zeit gekostet. Aber das Ergebnis ist prima.
Hat aber auch Spaß gemacht. Wahnsinn was man alles so mit so ein paar Codezeilen erreichen kann.
Schön zu hören, so solls sein.Danke und Gruß
Gerne, und weiterhin erfolgreiches Coding.LÖSUNG 28.04.2017 um 08:37 Uhr
LÖSUNG 28.04.2017, aktualisiert um 09:36 Uhr
Du nimmst das NewMailEx Event dazu in ThisOutlookSession:
Da mehrere Mails auf einmal eintreffen können enthält die Event-Variable "EntryIDCollection" mehrere uniqueIDs der Mails welche mit einer For-Schleife nacheinander verarbeitet werden. objItem enthält dann in der Schleife jeweils das Mail-Objekt mit dem du arbeiten kannst.
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim varEntryIDs, objItem As Object,i As Integer
varEntryIDs = Split(EntryIDCollection, ",")
For i = 0 To UBound(varEntryIDs)
Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
' in objItem ist die neue Mail zum verarbeiten
' hier also dein Code zum Verarbeiten der Mail
Next
LÖSUNG 28.04.2017, aktualisiert um 11:23 Uhr
OK, habe den kompletten Code in die NewMailEx Sub unterhalb der For Schleife eingebunden. Erstmal ohne mit objItem zu arbeiten.
wo kann ich denn jetzt mit objItem weiter arbeiten?
Eigentlich läuft es jetzt, allerdings habe ich noch nicht alles testen können. Was funktioniert denn nicht?
For i = 0 To UBound(varEntryIDs)
Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
' in objItem ist die neue Mail zum verarbeiten
' hier also dein Code zum Verarbeiten der Mail
If TypeName(myMtgReq) <> "Nothing" Then
For Each m In myMtgReq
If m.Subject = "I-55023414-:0" Or m.Subject = "I-55023399-:0" Then
Set myAppt = m.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
myMtg.Send
m.UnRead = False
myCol.Add m
End If
If m.Subject = "U-55023414-:0" Or m.Subject = "U-55023399-:0" Then
Set myAppt = m.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
m.UnRead = False
myCol.Add m
End If
Next
If myCol.Count >= 1 Then
For Each element In myCol
element.Delete
Next
End If
End If
Set myCol = Nothing
Next
Eigentlich läuft es jetzt, allerdings habe ich noch nicht alles testen können. Was funktioniert denn nicht?
LÖSUNG 28.04.2017 um 11:37 Uhr
Du hast das Prinzip von Schleifen anscheinend noch nicht ganz Verstanden.
Statt hier myMtgReq und eine zusätzliche Schleife zu verwenden nutzt du hier objItem da dies das gerade eingetroffene Objekt (also die Mail) beinhaltet! Du brauchst also in diesem Fall keine zusätzliche Schleife in der Schleife mehr weil du das einzelne Objekt direkt bearbeitest und nicht mehr alle Items des Ordners durchlaufen musst!
Statt hier myMtgReq und eine zusätzliche Schleife zu verwenden nutzt du hier objItem da dies das gerade eingetroffene Objekt (also die Mail) beinhaltet! Du brauchst also in diesem Fall keine zusätzliche Schleife in der Schleife mehr weil du das einzelne Objekt direkt bearbeitest und nicht mehr alle Items des Ordners durchlaufen musst!
LÖSUNG 28.04.2017 um 14:57 Uhr
LÖSUNG 28.04.2017, aktualisiert um 15:33 Uhr
Zitat von @speedy132:
Wie kann ich objItem mit mymtgReq austauschen? Das verstehe ich nicht, da die Eigenschaften oder Methoden von mymtgReq doch dann gar nicht zur Verfügung stehen.
Doch, du siehst sie nur nicht in der Intellisense weil es ein "Object" ist. Verfügbar sind sie trotzdem.Wie kann ich objItem mit mymtgReq austauschen? Das verstehe ich nicht, da die Eigenschaften oder Methoden von mymtgReq doch dann gar nicht zur Verfügung stehen.
Aber da zeigt sich bestimmt wieder meine Unwissenheit 
Jepp.Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim varEntryIDs, objItem As Object,i As Integer, col As New Collection
varEntryIDs = Split(EntryIDCollection, ",")
For i = 0 To UBound(varEntryIDs)
Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
If objItem.Subject = "I-55023414-:0" Or objItem.Subject = "I-55023399-:0" Then
Set myAppt = objItem.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
myMtg.Send
objItem.UnRead = False
myCol.Add objItem
End If
If objItem.Subject = "U-55023414-:0" Or objItem.Subject = "U-55023399-:0" Then
Set myAppt = objItem.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
objItem.UnRead = False
myCol.Add objItem
End If
Next
For Each element In myCol
element.Delete
Next
End Sub