简体   繁体   中英

Get email from non default inbox?

I am using the following vba code to get emails from my inbox folder and move them to a sub folder called suppliers. At the moment the emails are moved from my default email inbox, but I have an account called purcashing@hewden.co.uk and I want it to get the emails from this inbox and move it to the subfolder called Suppliers in this account.

can someone show me how I would alter GetDefaultFolder to make this happen. thanks

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

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

I just used Dmitry's suggestion and it works like a charm.

Hope it helps \\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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM