Edit: I actually figured this out! I replaced the line
Set outlookInbox = outlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
with
Dim NS As Outlook.Namespace
Dim objOwner As Outlook.Recipient
Set NS = outlookApp.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("[email protected]")
Objowner.Resolve
If objOwner.Resolved Then
MsgBox objOwner.Name 'You can comment this out if you want
Set outlookInbox = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
End If
Original Post: I have this code that I run in Excel VBA that searches for a specific sender and attachment name in my Outlook default Inbox. It then saves the attachment to a designated folder on my desktop while renaming the file with the date on which the email was received.
However, I want to edit the code so that it searches not in my default Inbox, but in a different, shared mailbox in my Outlook. Assume the email address at which this shared mailbox receives emails is [email protected]. This is obviously separate from my own personal email address.
How can I edit this code so it searches in this mailbox and not in my own Inbox?
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