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

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

移动此行代码

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）

1 个答案: