Question

我正在尝试构建一个脚本，该脚本会自动修改特定文件夹中的新传入电子邮件并将其发送给其他人。修改/发送部分效果很好。但是问题在于，当有一封新电子邮件时，该脚本不起作用。它只有在我将其转移给自己时才会出现。

这是代码的开头：

 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("DI").Items
                End Sub
                Private Sub Items_ItemAdd(ByVal item As Object)

                 Dim Msg As Outlook.MailItem
                 If TypeName(item) = "MailItem" Then
                Set Msg = item

Answer 1

您是否重新启动了Outlook？请参考以下代码：

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim olApp As Outlook.Application

  Set olApp = Outlook.Application
  Set Items = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("Stuff").Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

  On Error GoTo ErrorHandler

  MsgBox "You moved an item into the 'Stuff' folder."

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

Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
  Set GetNS = app.GetNamespace("MAPI")
End Function

以下是链接：VBA Outlook event moving email

为什么我的WithEvent在Outlook vba中不起作用？

1 个答案: