VBA 如何处理 ItemAdd 和 ItemChange 事件（对于 Outlook 2016 日历）？

问题描述 投票：0回答：3

我在 Windows 10（64 位）上使用 Microsoft Outlook 2016 日历的离线版本。

目标：

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

到目前为止我已经尝试过：

Diane Poremsky 写了一篇很好的文章，解释了如何处理 Mail 的 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，也不适用于 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)
    
 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 都可以工作？换句话说，每当添加新约会或修改现有约会时，弹出消息将显示约会的 GlobalAppointmentID。

谢谢你。

vba outlook
3个回答
0
投票

问题解决了。

如果有人感兴趣，下面的代码捕获了 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
0
投票

不要在事件处理程序中将作为参数传递给 

Nothing
的项目设置：

Set Item = Nothing

作为参数传递的项目由调用者释放（在您的情况下为 Outlook）。

无需在代码中保留 

Items
类的两个实例即可处理事件。首先尝试不要释放作为参数传递的项目。

0
投票

问题或其他答案中未提及的一件事是代码位于“Microsoft Outlook 对象”>“ThisOutlookSession”中。

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.