speedy132
Goto Top

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

Content-Key: 335995

Url: https://administrator.de/contentid/335995

Ausgedruckt am: 19.03.2024 um 05:03 Uhr

Mitglied: 132895
132895 24.04.2017 aktualisiert um 17:25:41 Uhr
Goto Top
Kann ich so eine Regel selbst erstellen (evtl. vba)?
AppointmentItem.Respond Method (Outlook)
oder
Ressourcen-Postfach am Exchange mit Buchungsautomatik erstellen?

Gruß
Mitglied: speedy132
speedy132 25.04.2017 um 08:58:18 Uhr
Goto Top
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
Mitglied: 132895
132895 25.04.2017 aktualisiert um 09:28:07 Uhr
Goto Top
Mach einfach eine For-Each-Schleife über das Ergebnis des Finds und prüfe dann per IF-Abfrage die Eigenschaft Subject face-wink.
Mitglied: speedy132
speedy132 25.04.2017 um 10:15:45 Uhr
Goto Top
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
Mitglied: 132895
132895 25.04.2017 aktualisiert um 10:20:59 Uhr
Goto Top
for each m in myMtgReq
 'und hier dann statt myMtgReq das 'm' einsetzen. (Laufvariable)  
Next
Mitglied: speedy132
speedy132 25.04.2017 um 10:50:59 Uhr
Goto Top
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?
Mitglied: 132895
132895 25.04.2017 aktualisiert um 10:54:49 Uhr
Goto Top
Du hast das m nicht in den anderen Zeilen innerhalb der For-Schleife ersetzt face-wink. 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 face-sad Das sind einfachste Grundlagen die du überall nachlesen kannst.
Wenn du das nicht willst, fang gar nicht erst das Programmieren an!!
Mitglied: speedy132
speedy132 25.04.2017 um 10:58:34 Uhr
Goto Top
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?
Mitglied: 132895
132895 25.04.2017 aktualisiert um 11:25:16 Uhr
Goto Top
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 face-wink. Du darfst jetzt natürlich nicht das mymtgReq als Meeting deklarieren weil das Ergebnis mehrere Items sind !!!
Dim myMtgReq As Items
Mitglied: speedy132
speedy132 25.04.2017 um 12:14:13 Uhr
Goto Top
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?
Mitglied: 132895
132895 25.04.2017 aktualisiert um 12:19:33 Uhr
Goto Top
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.
Mitglied: speedy132
speedy132 27.04.2017 um 10:31:39 Uhr
Goto Top
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
Mitglied: 132895
132895 27.04.2017 aktualisiert um 10:38:28 Uhr
Goto Top
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!!
Mitglied: speedy132
speedy132 27.04.2017 um 11:31:42 Uhr
Goto Top
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...

???
Mitglied: 132895
132895 27.04.2017 um 11:36:12 Uhr
Goto Top
Mitglied: speedy132
speedy132 27.04.2017 um 13:20:07 Uhr
Goto Top
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
Mitglied: 132895
132895 27.04.2017 um 13:40:54 Uhr
Goto Top
Na die Delete-Methode des Items aufrufen, es ist ja immer noch ein AppointmentItem.
for each element in mycol
    element.Delete
Next
Mitglied: speedy132
speedy132 27.04.2017 um 14:17:32 Uhr
Goto Top
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 face-smile
Mitglied: 132895
132895 27.04.2017 aktualisiert um 14:23:02 Uhr
Goto Top
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!
Mitglied: speedy132
speedy132 27.04.2017 um 14:51:41 Uhr
Goto Top
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
Mitglied: 132895
132895 27.04.2017 aktualisiert um 15:05:02 Uhr
Goto Top
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.
Mitglied: speedy132
speedy132 28.04.2017 um 08:37:05 Uhr
Goto Top
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
Mitglied: 132895
132895 28.04.2017 aktualisiert um 09:36:19 Uhr
Goto Top
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.
Mitglied: speedy132
speedy132 28.04.2017 aktualisiert um 11:23:08 Uhr
Goto Top
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?
Mitglied: 132895
132895 28.04.2017 um 11:37:49 Uhr
Goto Top
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!
Mitglied: speedy132
speedy132 28.04.2017 um 14:57:49 Uhr
Goto Top
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 face-sad

Danke
Mitglied: 132895
Lösung 132895 28.04.2017 aktualisiert um 15:33:36 Uhr
Goto Top
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 face-sad
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