Outlook添加項目退出工作 - Items_ItemAdd（作爲對象的ByVal項目）

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!") 

這裏完整的代碼上展望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