VBA如何事件处理ItemAdd和ItemChange两者(适用于Outlook 2016日历)？

Question

我在Windows 10(64位(上使用脱机版本的Microsoft Outlook 2016日历。

目标：

创建新约会时，或者修改现有约会时，我希望弹出一个消息框并显示约会的GlobalAppointmentID。

到目前为止我尝试过的：

Diane Poremsky写了一篇很好的文章，解释了如何处理邮件的ItemAdd事件。我在《日历》中采用了它，它奏效了。每当在日历中创建新的约会时，下面显示的代码将显示GlobalAppointmentID作为弹出消息。它适用于ItemAdd(无ItemChange(：

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items
Private Sub Application_Startup()

Dim objWatchFolder As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")
'Set the folder and items to watch:
Set objWatchFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objItems = objWatchFolder.Items
Set objWatchFolder = Nothing
End Sub

Private Sub objItems_ItemAdd(ByVal Item As Object)
' Your code goes here
' MsgBox "Message subject: " & Item.Subject & vbCrLf & "Message sender: " & Item.SenderName & " (" & Item.SenderEmailAddress & ")"
' https://www.slipstick.com/developer/itemadd-macro
MsgBox "*** PROPERTIES of olFolderCalendar ***" & vbNewLine & _
"Subject: " & Item.Subject & vbNewLine & _
"Start: " & Item.Start & vbNewLine & _
"End: " & Item.End & vbNewLine & _
"Duration: " & Item.Duration & vbNewLine & _
"Location: " & Item.Location & vbNewLine & _
"Body: " & Item.Body & vbNewLine & _
"Global Appointment ID: " & Item.GlobalAppointmentID

Set Item = Nothing
End Sub

每当修改现有约会时，下面显示的代码将显示GlobalAppointmentID的弹出消息。它适用于ItemChange(没有ItemAdd(：

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items
Private Sub Application_Startup()

Dim objWatchFolder As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")
'Set the folder and items to watch:
Set objWatchFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objItems = objWatchFolder.Items
Set objWatchFolder = Nothing
End Sub
Private Sub objItems_ItemChange(ByVal Item As Object)
MsgBox "*** PROPERTIES of olFolderCalendar ***" & vbNewLine & _
"Global Appointment ID: " & Item.GlobalAppointmentID

Set Item = Nothing
End Sub

但是，当我在同一VBA代码中组合ItemAdd和ItemChange时，它们都不起作用。下面显示的代码不适用于ItemAdd，也不适用于ItemsChange:

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items
Private Sub Application_Startup()

Dim objWatchFolder As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")
'Set the folder and items to watch:
Set objWatchFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objItems = objWatchFolder.Items
Set objWatchFolder = Nothing
End Sub

Private Sub objItems_ItemAdd(ByVal Item As Object)

MsgBox "*** PROPERTIES of olFolderCalendar ***" & vbNewLine & _
"Subject: " & Item.Subject & vbNewLine & _
"Start: " & Item.Start & vbNewLine & _
"End: " & Item.End & vbNewLine & _
"Duration: " & Item.Duration & vbNewLine & _
"Location: " & Item.Location & vbNewLine & _
"Body: " & Item.Body & vbNewLine & _
"Global Appointment ID: " & Item.GlobalAppointmentID

Set Item = Nothing
End Sub


Private Sub objItems_ItemChange(ByVal Item As Object)
MsgBox "*** PROPERTIES of olFolderCalendar ***" & vbNewLine & _
"Global Appointment ID: " & Item.GlobalAppointmentID

Set Item = Nothing
End Sub

问题：

我应该如何更正代码，以便ItemAdd和ItemChange都能工作？换句话说，每当添加新的约会或修改现有约会时，弹出的Msg将显示约会的GlobalAppointmentID。

谢谢。

Answer 1

问题已解决。

如果有人感兴趣，下面的代码将捕获ItemAdd和ItemChange。

我制作了一个单独的WithEvents和一个单独的Set ObjItems

然后它起作用了。

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items
Private WithEvents objItems2 As Outlook.Items
Private Sub Application_Startup()

Dim objWatchFolder As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")
'Set the folder and items to watch:
Set objWatchFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objItems = objWatchFolder.Items
Set objItems2 = objWatchFolder.Items
Set objWatchFolder = Nothing
End Sub

Private Sub objItems_ItemAdd(ByVal Item As Object)
' Your code goes here
' MsgBox "Message subject: " & Item.Subject & vbCrLf & "Message sender: " & Item.SenderName & " (" & Item.SenderEmailAddress & ")"
' https://www.slipstick.com/developer/itemadd-macro
MsgBox "*** PROPERTIES of olFolderCalendar ***" & vbNewLine & _
"Subject: " & Item.Subject & vbNewLine & _
"Start: " & Item.Start & vbNewLine & _
"End: " & Item.End & vbNewLine & _
"Duration: " & Item.Duration & vbNewLine & _
"Location: " & Item.Location & vbNewLine & _
"Body: " & Item.Body & vbNewLine & _
"Global Appointment ID: " & Item.GlobalAppointmentID

Set Item = Nothing
End Sub


Private Sub objItems2_ItemChange(ByVal Item As Object)
MsgBox "*** PROPERTIES of olFolderCalendar ***" & vbNewLine & _
"Subject: " & Item.Subject & vbNewLine & _
"Start: " & Item.Start & vbNewLine & _
"End: " & Item.End & vbNewLine & _
"Duration: " & Item.Duration & vbNewLine & _
"Location: " & Item.Location & vbNewLine & _
"Body: " & Item.Body & vbNewLine & _
"Global Appointment ID: " & Item.GlobalAppointmentID

Set Item = Nothing
End Sub

Answer 2

不要在事件处理程序中设置作为参数传递给Nothing的项：

Set Item = Nothing

作为参数传递的项目由调用方发布(在您的情况下为Outlook(。

不需要在代码中保留Items类的两个实例就可以处理事件。请先尝试不释放作为参数传递的项。