从非默认收件箱中获取电子邮件?

时间:2014-10-09 09:09:13

标签: vba outlook outlook-vba

我正在使用以下vba代码从我的收件箱文件夹中获取电子邮件,并将其移至名为供应商的子文件夹。目前电子邮件是从我的默认电子邮件收件箱中移出的,但我有一个名为purcashing@hewden.co.uk的帐户,我希望它从此收件箱中获取电子邮件并将其移至此帐户中名为“供应商”的子文件夹中。

有人可以告诉我如何改变GetDefaultFolder来实现这一目标。感谢

Sub MoveItems()
 Dim myNameSpace As Outlook.NameSpace
 Dim myInbox As Outlook.Folder
 Dim myDestFolder As Outlook.Folder
 Dim myItems As Outlook.Items
 Dim myItem As Object


 Set myNameSpace = Application.GetNamespace("MAPI")
 Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
 Set myItems = myInbox.Items
 Set myDestFolder = myInbox.Folders("Supplier")
 Set myItem = myItems.Find("[Subject] = 'Introduction'")
 While TypeName(myItem) <> "Nothing"
 myItem.Move myDestFolder
 Set myItem = myItems.FindNext
 Wend
End Sub

2 个答案:

答案 0 :(得分:1)

不使用Namespace.GetDefaultFolder,而是从Namespace.Stores集合中检索相应的存储,并使用Store.GetDefaultFolder。

答案 1 :(得分:0)

我只是使用了德米特里的建议,它就像一个魅力。

希望它有所帮助\ o /

Sub GetEmailFromNonDefaultInbox()
    Dim myOlApp As New Outlook.Application
    Dim myNameSpace As Outlook.Namespace
    Dim myInbox As Outlook.MAPIFolder
    Dim myitems As Outlook.Items
    Dim strFilter As String

    ' let the user choose which account to use
    Set myAccounts = myOlApp.GetNamespace("MAPI").Stores
    For i = 1 To myAccounts.count
        res = MsgBox(myAccounts.Item(i).DisplayName & "?", vbYesNo)
        If res = vbYes Then
            Set myInbox = myAccounts.Item(i).GetDefaultFolder(olFolderInbox)
            Exit For
        End If
    Next
    If myInbox Is Nothing Then Exit Sub ' avoid error if no account is chosen

    ' query emails by subject
    strFilter = "@SQL=""urn:schemas:httpmail:subject"" like '%YOUR SUBJECT%'"
    Set myitems = myInbox.Items.Restrict(strFilter)

    ' show some feedback if no email is found
    If myitems.count = 0 Then 
        MsgBox "Nothing found. Try another account."
        Exit Sub
    End If

    ' get the most recent email
    myitems.Sort "ReceivedTime", True
    Set myitem = myitems.GetFirst
    If myitem.Class = olMail Then
        ' and now you can do whatever you want
        MsgBox (myitem.Subject)
    End If
End Sub