Outlook 添加项目退出工作 - Items_ItemAdd(ByVal Item As Object)

Question

我正在观察新项目，然后调用子程序。我目前正在使用消息框代替子例程进行测试。

最初代码运行正常。运行几次后，它停止工作。如果我关闭 Outlook 并重新打开，它会再次工作几次。我搜索了很多网站寻找答案。

我尝试备份项目文件，删除它，恢复它。我能够再次使用这段代码一段时间。现在我无法让它工作，无论我做什么。我已经为此工作了两天，但我不明白出了什么问题。我是运行 Outlook 2010，我的代码发布在下面。

代码保存在This Outlook Session:

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  ' default local Inbox
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Folders("Access Data Collection Replies").Items
End Sub


Private Sub Items_ItemAdd(ByVal item As Object)

  On Error GoTo ErrorHandler
  Dim Msg As Outlook.MailItem
  If TypeName(item) = "MailItem" Then
    Set Msg = item
    ' ******************
    ' This is going to be the code to respond to the dealer and to call   procedures. Maybe it can be handled with case statements.  Then each event can be identified.
    ' ******************
    MsgBox("It Worked!")
    Call AnswerD

  End If
ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

Answer 1

你的代码可以找到，如果你想让消息框弹出，那么

移动此行代码

MsgBox ("It Worked!")

在

旁边

  If TypeName(item) = "MailItem" Then
      MsgBox ("It Worked!")

这里是在 Outlook 2010

上测试的完整代码

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim olNameSpace     As Outlook.NameSpace

    Set olNameSpace = Application.GetNamespace("MAPI")
    '// ' Default local Inbox (olFolderInbox) & sub ("Folder Name")
    Set Items = olNameSpace.GetDefaultFolder(olFolderInbox).Folders("Access Data Collection Replies").Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
    If TypeOf item Is Outlook.MailItem Then
        MsgBox ("It Worked!")
        'AnswerD '<-- un-comment to call subroutine.
    End If
End Sub

Private Sub SaveMovePrint(OlMail As Outlook.MailItem)
    'On Error GoTo ErrorHandler
    ' ******************
    ' Here subroutine
    ' ******************
ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

Outlook 添加项目退出工作 - Items_ItemAdd(ByVal Item As Object)

Outlook Add Items quits working - Items_ItemAdd(ByVal Item As Object)

vba

outlook

outlook-2010