2014-10-09 98 views
2

我使用以下vba代碼從我的收件箱文件夾中獲取電子郵件,並將它們移動到名爲suppliers的子文件夾。目前,電子郵件已從我的默認電子郵件收件箱移出,但我有一個名爲[email protected]的帳戶,我希望它從此收件箱中獲取電子郵件並將其移至名爲供應商的子文件夾。從非默認收件箱收到電子郵件?

有人可以告訴我如何改變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 

回答

1

而不是使用Namespace.GetDefaultFolder的,檢索來自Namespace.Stores收集相應的存儲和使用Store.GetDefaultFolder。

+0

不GetDefaultFolder,但GetRootFolder。商店沒有GetDefaultFolder方法。 – JohnyL 2015-11-14 12:48:23

+0

Store.GetDefaultFolder在Outlook 2010中添加。Store.GetRootFolder然後按名稱打開文件夾在本地化環境中不起作用。 – 2015-11-14 17:36:17

+0

OP沒有提及Office版本,所以GetRootFolder可以在2007和2010+工作。 – JohnyL 2015-11-15 18:40:57

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