|
Hallo
es besteht das Problem oder zumindest der Verdacht , daß aus dem Outlook Kalender Einträge verschwinden,
ohne mein aktives dazutun, ggf. eine falsche Einstellung in Outlook. Eingehende Besprechungsanfrage pflege ich
aktuell auch in anderen Terminplanern, sodaß kein Termin verloren geht.
Den einzigen Hinweis auf den Termin, der verloren ging, war im Outlook-Ordner 'gelöschte Elemente'.
Alle Meeting-Requests im Outlook-Ordner 'gelöschte Elemente' (ggf. später zusätzlich auch andere Ordner)
sollen mit
Subject ,
ReceivedTime , und
calendarItem.GetAssociatedAppointment(False).Start
erfasst werden, unabhängig davon, ob der Termin nun aktualisiert wurde , oder nicht.
Im Zweifelsfalle findet ein Abgleich mit Kollegen statt.
Im 'Fall 1' : der Termin ist im Kalender auch vorhanden funktioniert der Bezug
auf calendarItem.GetAssociatedAppointment(False).Start ; dann brauche ich ihn eigentlich nicht: ich sehe den Termin ja im Kalender
Im 'Fall 2' und 'Fall 3' werden die Termine in Outlook angezeigt , aber ich kenne die Vorgehensweise in VBA nicht, wie man
diese Terminfelder abfragen kann. Hier ist
Set A = calendarItem.GetAssociatedAppointment(False)
und
A Is Nothing
.
Das Programm läuft ohne Fehler durch, der Bezug auf die Termindaten des Meetings ist bis jetzt nur möglich, wenn
das Meeting auch tatsächlich im Kalender eingetragen ist. (Gutfall)
Verwendet wird: Office 365 (Microsoft 365 Apps for Enterprise) und Excel Version 2402
Gruß B.Kochs
Fall 1 ____________________________________________________________________________________
Meeting_der_Abteilung_A
28.06.2024 15:11:03
A.Start 09.09.2024 09:30:00
<Mail im gelöschten Ordner> :
keine Hinweis auf ein Nichtvorhandensein des Kalenderelements: der Termin ist ja auch im Kalender
___________________________________________________________________________________________
Fall 2 ____________________________________________________________________________________
Meeting_der_Abteilung_A
28.06.2024 13:15:03
A is Nothing
<Mail im gelöschten Ordner> :
Diese Besprechungsanfrage wurde aktualisiert, nachdem diese Nachricht gesendet wurde.
Öffnen Sie eine spätere Aktualisierung, oder öffnen Sie das Element im Kalender.
___________________________________________________________________________________________
Fall 3 ____________________________________________________________________________________
Meeting_der_Abteilung_A
28.06.2024 15:21:34
A is Nothing
<Mail im gelöschten Ordner> :
Diese Besprechung wurde im Kalender nicht gefunden. Sie wurde möglicherweise verschoben oder gelöscht
___________________________________________________________________________________________
start der sub aus BK_Class ________________________________________________________________________________
Sub Test_CM()
Dim o_BK_Class As New BK_Class
o_BK_Class.EnumerateDefaultAppointmentsAndDoSomethingSillyThatIllustratesAPoint ("")
End Sub
Klassenmodul: BK_Class ____________________________________________________________________________________
Friend Sub EnumerateDefaultAppointmentsAndDoSomethingSillyThatIllustratesAPoint(calendarType As String)
'https://stackoverflow.com/questions/4365890/find-underlying-object-type-for-outlook-meetingitem
'https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/object-variable-not-set-error-91
Dim myOutlookApp As Object
Dim myNameSpace As Outlook.Namespace
Dim myFolder As Outlook.Folder
Dim calendar As Outlook.Folder
Dim calendarItems As Outlook.Items
Dim calendarItem As Object
Dim A As AppointmentItem
'Dim myAppt As AppointmentItem
Dim myMtg As Outlook.MeetingItem
Set myOutlookApp = CreateObject("Outlook.Application")
Set myNameSpace = myOutlookApp.GetNamespace("MAPI")
Set calendar = myNameSpace.GetDefaultFolder(olFolderDeletedItems)
Set calendarItems = calendar.Items.Restrict("[MessageClass] = 'IPM.Schedule.Meeting.Request'")
'If calendarType = "AppointmentItem" Then
' calendar = OutlookApp.Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
' calendarItems = calendar.Items
'Else 'MeetingItem (are assume that is the case)
' calendar = OutlookApp.Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
' calendarItems = calendar.Items
'End If
'Dim i As Integer
'i = 0
'Do Until i = calendarItems.Count
'With myFolder.Items.Restrict("[MessageClass] = 'IPM.Schedule.Meeting.Request'").Item(olItemsCount)
' Console.WriteLine (calendarItems(i - 1).MessageClass)
'AppointmentItem = IPM.Appointment
'MeetingRequest = IPM.Schedule.Meeting.Request
'Loop
'funzt zum Teil
'Debug.Print String(65535, vbCr)
For olItemsCount = 1 To calendarItems.Count
Set calendarItem = calendarItems.Item(olItemsCount)
'Debug.Print (calendarItem.Subject) ' <-funktioniert für alle Item - Objekte ohne Fehler
'Set myAppt = calendarItem.GetAssociatedAppointment(False)
'Debug.Print (calendarItems.Item(olItemsCount).Subject)
'Debug.Print (myAppt.Start) ' <-funktioniert nur für das erste Item , beim 2. Element : Laufzeitfehler 91 Objektvariable ... nicht festgelegt
'https://learn.microsoft.com/en-us/office/vba/api/outlook.appointmentitem
If calendarItem.MessageClass = "IPM.Schedule.Meeting.Request" Then
If (calendarItems.Item(olItemsCount).Subject = "Meeting_der_Abteilung_A") Then
Debug.Print (calendarItems.Item(olItemsCount).Subject)
Debug.Print (calendarItems.Item(olItemsCount).ReceivedTime)
Set A = calendarItem.GetAssociatedAppointment(False)
If (A Is Nothing) Then
Debug.Print ("A is Nothing ")
Else
Debug.Print ("A.Start " & A.Start)
End If
Debug.Print ("__________________________________")
End If
Else
Debug.Print ("Meeting.Request NO")
End If
Next
'Release COM Objects!
'If calendarItems Is Not Null Then
' Marshal.ReleaseComObject (calendarItems)
'End If
'If calendar Is Not Null Then
' Marshal.ReleaseComObject (calendar)
'End If
End Sub
|