Question

我想在这里请求你的帮助。我正在尝试编写脚本（Outlook加载项VSTO）以侦听来自特定Outlook帐户的所有传入电子邮件。在我的Outlook应用程序中，我设置了一些帐户（Exchange帐户），但我只对其中一个帐户感兴趣。我有以下代码从当前默认帐户收听收件箱文件夹。

Private Sub ThisAddIn_Startup() Handles Me.Startup

   Dim outlookNameSpace As Outlook.NameSpace
   outlookNameSpace = Me.Application.GetNamespace("MAPI")
   inbox = OutlookNameSpace.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
   Mailitem = inbox.Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object) Handles Mailitem.ItemAdd
   If TypeOf (item) Is Outlook.MailItem Then
       --Do some things here--
   End if

End Sub

代码运行完美，但它正在侦听默认帐户。我想将其更改为收听在Outlook中设置的其他帐户。

你有什么想法吗？

非常感谢!!

Answer 1

不使用Namespace.GetDefaultFolder，而是在Namespace.Stores集合中找到您所在的商店，并使用Store.GetDefaultFolder从该商店检索收件箱文件夹

Answer 2

这可能有帮助！！！在Outlook会话中复制此代码。 outlook session image

Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session

  Set olInboxItems = GetFolderPath("your other email address name\Inbox").Items
  Set objNS = Nothing

  Set objInbox = Application.Session.GetDefaultFolder(olFolderInbox)
  Set objItems = objInbox.Items

  End Sub

  Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
  On Error Resume Next
  'your code what you want to do  with additional email address
  End Sub

  Private Sub objItems_ItemAdd(ByVal Item As Object)
  'your code for your default email address
  End Sub

  Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
    Dim oFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer

    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.Item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function

    GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
End Function

使用vb监听特定的Outlook帐户

2 个答案: