excel - 扫描非默认 Outlook 收件箱中的电子邮件？

Question

我正在使用以下 vba 代码来检查任何具有特定主题标题的电子邮件。

问题是，当我需要它检查我的其他电子邮件帐户 NewSuppliers@Hewden.co.uk 的收件箱时，它会检查我的默认 Outlook 收件箱文件夹

有人可以告诉我如何做到这一点吗？提前致谢

Sub Macro1() Set olApp = CreateObject("Outlook.Application")
     Dim olNs As Outlook.Namespace
     Dim Fldr As Outlook.MAPIFolder
     Dim myItem As Outlook.MailItem
     Dim myAttachment As Outlook.Attachment
     Dim I As Long
     Dim olMail As Variant


     Set olApp = New Outlook.Application
     Set olNs = olApp.GetNamespace("MAPI")
     Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
     Set myTasks = Fldr.Items


  Set olMail = myTasks.Find("[Subject] = ""New Supplier Request: Ticket""")
  If Not (olMail Is Nothing) Then



    For Each myItem In myTasks
        If myItem.Attachments.Count <> 0 Then
            For Each myAttachment In myItem.Attachments
            If InStr(myAttachment.DisplayName, ".txt") Then
                I = I + 1
                myAttachment.SaveAsFile "\\uksh000-file06\Purchasing\NS\Unactioned\" & myAttachment
                End If
            Next
        End If

    Next



For Each myItem In myTasks
myItem.Delete
Next

Call Macro2

Else
MsgBox "There Are No New Supplier Requests."
End If
End Sub

Outlook 文件夹结构:

account1@hewden.co.uk
Inbox
Drafts
Sent

NewSuppliers@hewden.co.uk
Inbox
Drafts
Sent

Answer 1

您需要使用以下内容，假设您想要的文件夹位于文件夹层次结构中的同一级别

Set Items = Session.GetDefaultFolder(olFolderCalendar).Parent.Folders("YouFolderName").Items

请参阅此处了解更多详细信息... http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/

<小时/>

您是否尝试过上述链接中的以下功能...

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

您可能需要首先使用此处的技术来找出实际的文件夹名称... https://msdn.microsoft.com/en-us/library/office/ff184607.aspx

<小时/>

在下图中，Drafts、Clients、Outbox 文件夹都位于同一级别(它们共享相同的父文件夹 james@...com)，但 ChildFolder 文件夹不是(它的父文件夹是 Drafts)。