24.04.2017

2737

Outlook 2013 Kalendereintrag per Regel akzeptieren und löschen

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

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 335995

Url: https://administrator.de/forum/outlook-2013-kalendereintrag-per-regel-akzeptieren-und-loeschen-335995.html

Ausgedruckt am: 17.07.2025 um 15:07 Uhr

27 Kommentare

Neuester Kommentar

Kann ich so eine Regel selbst erstellen (evtl. vba)?

AppointmentItem.Respond Method (Outlook)
oder
Ressourcen-Postfach am Exchange mit Buchungsautomatik erstellen?

Gruß

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

Mach einfach eine For-Each-Schleife über das Ergebnis des Finds und prüfe dann per IF-Abfrage die Eigenschaft Subject

Komme hier nicht weiter ...

If TypeName(myMtgReq) <> "Nothing" Then
For Each myMtgReq in ?????
If myMtgReq.Subject = "test" Then
Set myAppt = myMtgReq.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
myMtg.Send
End If
Next
End If

for each m in myMtgReq
 'und hier dann statt myMtgReq das 'm' einsetzen. (Laufvariable)  
Next

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?

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!!

For Each m In myMtgReq
If m.Subject = "test" Then
Set myAppt = m.GetAssociatedAppointment(True)
Set myMtg = myAppt.Respond(olResponseAccepted, True)
myMtg.Send
End If
Next

Aber der Anfang der Schleife ist glaube ich schon fehlerhaft. Muss das m nicht noch deklariert werden?

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

. Du darfst jetzt natürlich nicht das mymtgReq als Meeting deklarieren weil das Ergebnis mehrere Items sind !!!

Dim myMtgReq As Items

ja, ich habe ja gesagt ich bin nicht so gut ...
Allerdings weiß ich auch nicht, wo ich so etwas spezielles in kürzester Zeit nachlesen soll.

Als was muss ich denn dann mymtgReq deklarieren?

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.

Als was muss ich denn dann mymtgReq deklarieren?

Steht oben.

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

Logisch, weil du mit

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!!

Ja das hört sich gut an...
Jetzt die Frage, wie muss ich das machen?

Habe jetzt folgendes probiert:
Dim myItem As Outlook.MailItem

Im if-Block dann
Set myItem = m.Items.Add
Aber funktioniert nicht...

???

Lese und lerne!
analystcave.com/vba-collection/

Danke, sehr interessant.

Allerdings habe ich jetzt das Problem, wie kann ich die Mails löschen, nicht nur die Collection leeren.

Im If Block
myCol.Add m

Am Ende dann

If myCol.Count >= 1 Then
        myCol.Remove (m)   -> funktioniert tnicht....
End If

Na die Delete-Methode des Items aufrufen, es ist ja immer noch ein AppointmentItem.

for each element in mycol
    element.Delete
Next

Ja super, damit kann ich diesen Thread als gelöst erklären.
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

Herzlichen Dank an password für die Hilfestellung

Find ich super das es hier auch User wie dich gibt denen man nicht alles vorbeten muss sondern die sich minimal mit der Materie auseinandersetzen mit den Infos die man Ihnen gibt! Daumen hoch!

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.

Danke und Gruß
Marcus

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.

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.

Eine Frage habe ich noch.
Ich habe jetzt diesen Code in ThisOutlookSession eingebunden und man kann ihn über "Makro" dann ausführen.
Wenn ich den jetzt automatisiert ablaufen lassen möchte, sobald eine neue Mail eintrifft, wie muss ich da vor gehen?

Gruß
Marcus

Du nimmst das NewMailEx Event dazu in ThisOutlookSession:

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

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.

OK, habe den kompletten Code in die NewMailEx Sub unterhalb der For Schleife eingebunden. Erstmal ohne mit objItem zu arbeiten.

 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

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?

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!

ja, da hast du Recht. Programmieren ist nicht meine Stärke.
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

Danke

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.

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