使用Excel中的VBA引用收件箱以外的Outlook邮箱
编辑:我真的弄明白了!我换了线使用Excel中的VBA引用收件箱以外的Outlook邮箱,excel,vba,outlook,Excel,Vba,Outlook,编辑:我真的弄明白了!我换了线 Set outlookInbox = outlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) 与 原始帖子:我在Excel VBA中运行此代码,在Outlook默认收件箱中搜索特定发件人和附件名称。然后,它将附件保存到我桌面上的指定文件夹中,同时使用收到电子邮件的日期重命名文件 但是,我希望编辑代码,使其不会在默认收件箱中搜索,而是在Outlook中的其他共享邮箱中搜索。假设此共享邮箱接收电
Set outlookInbox = outlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
与
原始帖子:我在Excel VBA中运行此代码,在Outlook默认收件箱中搜索特定发件人和附件名称。然后,它将附件保存到我桌面上的指定文件夹中,同时使用收到电子邮件的日期重命名文件
但是,我希望编辑代码,使其不会在默认收件箱中搜索,而是在Outlook中的其他共享邮箱中搜索。假设此共享邮箱接收电子邮件的电子邮件地址为sharedmailbox@companyname.com. 这显然与我个人的电子邮件地址是分开的
如何编辑此代码,使其在此邮箱而不是我自己的收件箱中搜索
Option Explicit
Sub GetLatestReport()
'Set a reference to Outlook's object library (Visual Basic >> Tools >> References >> check/select Microsoft Outlook Object Library)
Dim outlookApp As Outlook.Application
Dim outlookInbox As Outlook.MAPIFolder
Dim outlookRestrictItems As Outlook.Items
Dim outlookLatestItem As Outlook.MailItem
Dim outlookAttachment As Outlook.Attachment
Dim attachmentFound As Boolean
Const saveToFolder As String = "C:\Users\jalanger\Desktop\Demo" 'change the save to folder accordingly
Const senderName As String = "Langer, Jaclyn" 'change the sender name accordingly
Const attachmentName As String = "Report on ACBS LC for AMLS (Chandran Panicker)" 'change the attachment name accordingly
Dim SavePath As String
'Create an instance of Outlook
Set outlookApp = New Outlook.Application
'Get the inbox from Outlook
Set outlookInbox = outlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
'Filter the items from the inbox based on the sender
Set outlookRestrictItems = outlookInbox.Items.Restrict("[SenderName] = '" & senderName & "'")
'Check whether any items were found
If outlookRestrictItems.Count = 0 Then
MsgBox "No items were found from " & senderName & "!", vbExclamation
Exit Sub
End If
'Sort the filtered items by received time and in descending order
outlookRestrictItems.Sort Property:="[ReceivedTime]", Descending:=True
'Get the latest item from the filtered and sorted items
Set outlookLatestItem = outlookRestrictItems(1)
'Make sure that file extension at the end of this line is correct
SavePath = saveToFolder & "\" & attachmentName & " " & CStr(Format(outlookLatestItem.ReceivedTime, "Long Date")) & ".xls"
MsgBox SavePath
'Loop through each attachment from the latest item until specified file is found
attachmentFound = False
For Each outlookAttachment In outlookLatestItem.Attachments
If Left(UCase(outlookAttachment.FileName), Len(attachmentName)) = UCase(attachmentName) Then
outlookAttachment.SaveAsFile SavePath 'saveToFolder & "\" & outlookAttachment.DisplayName
attachmentFound = True
Exit For
End If
Next outlookAttachment
If attachmentFound Then
MsgBox "The attachment was found and saved to '" & saveToFolder & "'!", vbInformation
Else
MsgBox "No attachment was found!", vbExclamation
End If
Workbooks.Open FileName:=SavePath
End Sub
如果您在Outlook中设置了第二个帐户(例如。sharedmailbox@companyname.com)您可以替换此行:
Set outlookInbox = outlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
为此:
Set outlookInbox = outlookApp.GetNamespace("MAPI").Accounts.Item(2).Session.GetDefaultFolder(olFolderInbox)
这将使用第二个帐户的收件箱。您可以使用该帐户的DeliveryStore属性获取其收件箱。例如:
Sub ResolveName()
Dim ns As NameSpace
Set ns = Application.Session
Dim acc As Account
Dim f As Folder
For Each acc In ns.accounts
MsgBox acc.UserName
If acc = "text@outlook.com" Then
Set f = acc.DeliveryStore.GetDefaultFolder(olFolderInbox)
MsgBox f.Items.count
End If
Next
End Sub
您可以使用acc=”进行筛选text@outlook.com“或acc.UserName属性。是指两个单独的行,还是指(2).Session.GetDef…”。。。。在第二行中,是指在第一行末尾的项目后面紧跟?对不起,这都是指在一行中。我修改了答案。我得到了错误消息“数组索引超出范围”,知道为什么吗?我认为这意味着Outlook中只有一个帐户设置,或者在此上下文中至少只有一个可用。您是如何接收“的邮件的?”sharedmailbox@companyname.com“?邮箱的电子邮件地址为”ACBSMISREports@companyname.com,它有自己的收件箱、已发送邮件、草稿、已删除邮件等文件夹。我在Outlook中也有自己的个人电子邮件,MyName@companyname.com. 我已在Outlook中设置了这两个邮箱。这是一个共享邮箱,所以很多人在Outlook中也连接了它。一周一次,供应商向ACBSMISReports@companyname.com,我正在尝试使用我的代码访问该电子邮件。可能是
Sub ResolveName()
Dim ns As NameSpace
Set ns = Application.Session
Dim acc As Account
Dim f As Folder
For Each acc In ns.accounts
MsgBox acc.UserName
If acc = "text@outlook.com" Then
Set f = acc.DeliveryStore.GetDefaultFolder(olFolderInbox)
MsgBox f.Items.count
End If
Next
End Sub