我正在使用以下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
答案 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