Look through 2 outlook root folders in Excel with VBA - excel

I have managed to get access to the items in 2 folders in Outlook from Excel by using VBA, but now I want to search for the email address x#gmail.com in both aI know how to search each one individually, but once, and sort for the most recent one. The piece I am stuck on is how to look through both folders at once.
I am using Microsoft Office 2016
Obviously, this dummy line does not do the trick: Set olJoinedFldr = olCleanUp + olFldr
Private Sub CommandButton2_Click()
Dim olApp As Outlook.Application 'set app
Dim olNs As Object 'get namespace
Dim olFldr As Outlook.Folder 'to be the inbox
Dim olArchive As Outlook.Folder 'the archive folder
Dim olCleanUp As Outlook.Folder ' the archive subfolder we need
Dim olJoinedFldr As Object 'the to be made joined object to filter....
Dim olItems As Object 'filtered items based on search criteria
Dim olItemReply As Object 'the reply mail
Dim i As Long
Dim emailStr As String
Dim filter As String
Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(6) ' olFolderInbox
Set olArchive = olNs.Folders(CStr(olNs.Accounts.Item(1))) 'find email of current user
Set olCleanUp = olArchive.Folders("Archive").Folders("Cleanup") ' get the archive sub folder
Set olJoinedFldr = olCleanUp + olFldr
Set emailStr = "somebody#gmail.com"
filter = "[SenderEmailAddress] = """ & emailStr & """" 'this is the email from person x we are searching for in the 2 folders
' from here on it is currently searching just 1 folder
Set olItems = olFldr.Items.Restrict(filter) 'filter the items
olItems.Sort "[ReceivedTime]", True 'sort by date
If olItems.Count > 0 Then
For i = 1 To olItems.Count
If olItems(i).Class = 43 Then
Set olItemReply = olItems(i).ReplyAll
With olItemReply
.HTMLBody = "<p Dear someone, <br><br></p>" & .HTMLBody
.Display
End With
Exit For
End If
Next
Else
' have code here to make a brand new email already
End If
Set olApp = Nothing
Set olNs = Nothing
Set olFldr = Nothing
Set olArchive = Nothing
Set olCleanUp = Nothing
Set olJoinedFldr = Nothing
Set olItems = Nothing
Set olItemReply = Nothing
Set i = Nothing
Set emailStr = Nothing
Set filter = Nothing
End Sub

You cannot search through two (or more) folders unless you create a Search object using Application.AdvancedSearch. Even then, it is a PITA to work with - the search is asynchronous, and you would need to use events to figure out when the search is completed.
You'd be better off searching one folder at a time and combining the results (if necessary) in your code.

You need to use the AdvancedSearch method of the Application class. The key benefits of using the AdvancedSearch method in Outlook are:
The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
Full support for DASL queries (custom properties can be used for searching too). You can read more about this in the Filtering article in MSDN. To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
You can stop the search process at any moment using the Stop method of the Search class.
Read more about this method in the Advanced search in Outlook programmatically: C#, VB.NET article.

Related

Pulling e-mail addresses into excel with VBA from outlook

At work I have two e-mail accounts in outlook. One is an individual e-mail and the other is a general department e-mail.
How would I use VBA to get excel to access the general e-mail and pull the sender of each e-mail into a string? I need to iterate over each e-mail in the inbox ignoring e-mails in any sub folders.
Here's the code I've written so far. Hopefully I'm at least on the right track.
Public Sub test()
Dim emailApp As Outlook.Application, emailNamespace As Outlook.Namespace
Dim oFolder As MAPIFolder, oMail As Outlook.MailItem
Dim iSelect As Outlook.AccountSelector, iBox As Outlook.Account
Dim tEmailAddress As String
Set emailApp = New Outlook.Application
Set emailNamespace = OutlookApp.GetNamespace("MAPI")
Set oFolder = emailNamespace.GetDefaultFolder(olFolderInbox)
'I think im on the right track here.......
Set iBox = iSelect.SelectedAccount
For Each oMail In oFolder.Items
tEmailAddress = oMail.SenderEmailAddress
'Do other stuff for the project.........
Next
End Sub
EDIT: Posting a completed code sample for the next person who is having this problem.
Public Sub test()
Dim emailApplication As Outlook.Application, emailAccounts As Outlook.Accounts
Dim emailAccount As Outlook.Account, tAccount As Outlook.Account
Dim emailStore As Outlook.Store, emailInbox As Outlook.Folder, tMail As Variant
Set emailApplication = New Outlook.Application
Set emailAccounts = emailApplication.Session.Accounts
For Each tAccount In emailAccounts
If tAccount.DisplayName = "UserEmail#DemoEmail.com" Then: Set emailAccount = tAccount
Next
Set emailStore = emailAccount.DeliveryStore
Set emailInbox = emailStore.GetDefaultFolder(olFolderInbox)
On Error Resume Next
For Each tMail In emailInbox.Items
Debug.Print tMail.SenderEmailAddress
Next
Err.Clear
End Sub
The following code is not required:
'I think im on the right track here.......
Set iBox = iSelect.SelectedAccount
Instead, you may just rely on the GetDefaultFolder method which allows retrieving default folders (from the delivery store):
Set oFolder = emailNamespace.GetDefaultFolder(olFolderInbox)
If you need to choose a specific store in the profile you may find the required account by using the Namespace.Accounts property which returns an Accounts collection object that represents all the Account objects in the current profile. The Account.DeliveryStore property returns a Store object that represents the default delivery store for the account. The Store.GetDefaultFolder method returns a Folder object that represents the default folder in the store and that is of the type specified by the FolderType argument. This method is similar to the GetDefaultFolder method of the NameSpace object. The difference is that this method gets the default folder on the delivery store that is associated with the account, whereas NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile.
I need to iterate over each e-mail in the inbox ignoring e-mails in any sub folders.
The current folder is processed only when you deal with Folder.Items collection.

Excel VBA Outlook16 cannot read MailItem .Body property, though Outlook14 can

I have taken on a spreadsheet that has a VBA routine to read outlook emails
It works fine for me on Excel2010 (using the Outlook Office14.0 Object library) but now doesnt work for my colleague who's on Excel2016 (he's referenced the Outlook Office16.0 Object library in the VBA references), here's the key bits of code:
Dim olItms As Outlook.Items, Dim olMail As Variant,
For Each olMail In olItms
mailContents() = Split(olMail.Body, Chr(13))
I can add a Watch and see all of the emails in the chosen folder are in the olItms array
I can view the properties for each olMail object, eg sender & time received, all look fine.
In my Excel2010 I can read the .Body property and write it to Excel etc
In his Excel2016 I can similarly add a Watch and see all of the emails
I can similarly view the properties for each olMail object
However I cannot read the .Body property, it shows as <> instead of the text and nothing is read
In his Excel2016 session I can use the VBA to open/activate the email
I can also write to the .Body property in the VBA, eg olMail.Body = "test text" works, replacing the body of text in the open/activate email with "test text"
However I still can't read the body text.
The other similar fields (HTMLBody, RTFBody) similarly show as <> with no text read
I can't see anything in his Outlook properties that could be restricting it
The emails definitely have body text in them, as they get read ok in my Excel2010
The Outlook16 object libary must be working ok as the other email properties are reading ok (unless it could be partly working ?)
Here's a copy of all the code up to the error point (with some names changed)
Sub GetIncomeUpdatesFromInbox()
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olMailbox As Outlook.MAPIFolder
Dim olItms As Outlook.Items
Dim olMail As Variant, vRow As Variant
Dim i As Long
Dim FolderAddress As String, arrFolders() As String, mailContents() As String
Dim EarliestDate As Date
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
On Error Resume Next
Set olMailbox = olNs.Folders("mailbox#company.com").Folders("Inbox")
'Produces the relevant folder as a string
If Range("FolderAddress") = "Update" Or Range("FolderAddress") = "Create" Then
FolderAddress = "\\mailbox#company.com\*Folders\Data\xxx\"
Else
FolderAddress = "\\mailbox#company.com\*Folders\Data\xxx\Update\"
End If
FolderAddress = FolderAddress + Range("FolderAddress")
'changes Folder address into an array
arrFolders() = Split(FolderAddress, "\")
'Enters first part of fodler address
Set olFldr = olNs.Folders.Item(arrFolders(2))
'Navigates to relevant folder
If Not olFldr Is Nothing Then
For i = 3 To UBound(arrFolders)
Set colFolders = olFldr.Folders
Set olFldr = Nothing
Set olFldr = colFolders.Item(arrFolders(i))
If olFldr Is Nothing Then
Exit For
End If
Next
End If
Application.DisplayStatusBar = True
Set olItms = olFldr.Items
'Sorts emails by date received
olItms.Sort “Received”
i = 1
UserForm1.TextBox1 = Format(CDate(Evaluate("WORKDAY(TODAY(),-1)")), "dd/mm/yyyy")
UserForm1.TextBox2 = Format(CDate(Evaluate("WORKDAY(TODAY(),-0)")), "dd/mm/yyyy")
UserForm1.Show
EarliestDate = UserForm1.TextBox1
LatestDate = UserForm1.TextBox2
'moves through mails one by one for all emails received after specified earliest date"
iColumn = 3
For Each olMail In olItms
If LatestDate > CDate(olMail.ReceivedTime) Then
If CDate(olMail.ReceivedTime) > EarliestDate Then
'Splits content of the mail into an array with each element of the array one line in the original email
mailContents() = Split(olMail.Body, Chr(13))
Try to use the GetInspector or Display method before getting the message body.
Another point is a security trigger in the Outlook object model. Outlook may restrict access to secure properties when you automate the host from another process. You may try to run the same code from a COM add-in where you deal with a safe Application instance which doesn't trigger a security issue. There are several ways for suppressing such issues when dealing with OOM:
Use a third-party components for suppressing Outlook security warnings/issues. See Security Manager for Microsoft Outlook for more information.
Use a low-level API instead of OOM. Or any other third-party wrappers around that API, for example, Redemption.
Develop a COM add-in which has access to the trusted Application object. And then communicate from a standalone application with an add-in using standard .Net tools (Remoting).
Use group policy objects for setting up machines.
Install any AV software with the latest databases (up to date).
There are other aspects in the code listed above. Let's cover them in depth.
Instead of using the following code:
Set olMailbox = olNs.Folders("mailbox#company.com").Folders("Inbox")
You need to use the GetDefaultFolder method of the Namespace or Store class which is similar to the GetDefaultFolder method of the NameSpace object. The difference is that this method gets the default folder on the delivery store that is associated with the account, whereas NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile.
Iterating over all items in the folder is not really a good idea:
For Each olMail In olItms
If LatestDate > CDate(olMail.ReceivedTime) Then
If CDate(olMail.ReceivedTime) > EarliestDate Then
Use the Find/FindNext or Restrict methods of the Items class instead. Read more about these methods in the following articles:
How To: Retrieve Outlook calendar items using Find and FindNext methods
How To: Use Restrict method in Outlook to get calendar items

Join n outlook items into one new object with excel vba

I am looking for emails from person x in n outlook folders in Excel with VBA. What I want to do is find the most recent item of the n results (or of more folders).
I considered merging the n objects, sort by ReceivedTime and then get the top item, but I can't manage merging them, or find the most recent of the n objects.
Example is for 2 folders, 2 items:
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.Folder 'to be the inbox
Dim olArchive As Outlook.Folder 'my archive folder
Dim olItems As Outlook.Items
Dim olArchiveItems As Outlook.Items
Dim i As Long
Dim emailStr As String
Dim filter As String
Dim olSentFldr as Outlook.Folder
Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(6) ' olFolderInbox
Set olArchive = olNs.Folders(CStr(olNs.Accounts.Item(1)))
Set olSentFldr = olNs.GetDefaultFolder(olFolderSentMail)
emailStr = "somebody#outlook.com"
filter = "[SenderEmailAddress] = """ & emailStr & """"
Set olItems = olFldr.Items.Restrict(filter)
Set olArchiveItems = olArchive.Items.Restrict(filter)
olItems.Sort "[ReceivedTime]", True
olArchiveItems.Sort "[ReceivedTime]", True
olSentFldr.Sort "[ReceivedTime]", True
Dim olNew as Object
` below hypothetical solution that does not work yet--------------
olNew = merge(olItems(1), olArchiveItems(1))
olNew.Sort "[ReceivedTime]", True
myOutcome = olNew(1)
You can compare search results.
Option Explicit
Private Sub mostRecentItem_MultipleSearches()
' Early Binding - requires reference to Microsoft Outlook XX.X Object Library
Dim olApp As Outlook.Application
Dim olNs As Outlook.namespace
Dim olFldr As Outlook.Folder 'to be the inbox
Dim olSentFldr As Outlook.Folder
Dim olFldrItems As Outlook.Items
Dim olSentFldrItems As Outlook.Items
Dim olItemRecent As Object
Dim i As Long
Dim emailStr As String
Dim filter As String
Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
' valid with early binding
Set olFldr = olNs.GetDefaultFolder(olFolderInbox) ' 6 if late binding
Set olFldrItems = olFldr.Items
Debug.Print "olFldrItems.count: " & olFldrItems.count
emailStr = "somebody#outlook.com"
filter = "[SenderEmailAddress] = """ & emailStr & """"
olFldrItems.Sort "[ReceivedTime]", True
Set olFldrItems = olFldrItems.Restrict(filter)
Debug.Print "olFldrItems.count: " & olFldrItems.count
Set olItemRecent = olFldrItems(1)
'olItemRecent.Display
Set olSentFldr = olNs.GetDefaultFolder(olFolderSentMail)
Set olSentFldrItems = olSentFldr.Items
olSentFldrItems.Sort "[SentOn]", True
Debug.Print "olSentFldrItems.count: " & olSentFldrItems.count
Debug.Print olItemRecent.ReceivedTime
Debug.Print olSentFldrItems(1).SentOn
If olItemRecent.ReceivedTime < olSentFldrItems(1).SentOn Then
Set olItemRecent = olSentFldrItems(1)
End If
olItemRecent.Display
End Sub
First of all, you need to Sort collection before running the Restrict of Find/FindNext methods if you want to get items ordered.
olItems.Sort "[ReceivedTime]", True
olArchiveItems.Sort "[ReceivedTime]", True
olSentFldr.Sort "[ReceivedTime]", True
filter = "[SenderEmailAddress] = """ & emailStr & """"
Set olItems = olItems.Restrict(filter)
Set olArchiveItems = olArchiveItems.Restrict(filter)
Try using not a straight comparison in the search string:
filter = Chr(34) & "[SenderEmailAddress]" & Chr(34) & " like '%" & emailStr &"'"`
It looks like you need to use the AdvancedSearch method of the Application class which performs a search based on a specified DAV Searching and Locating (DASL) search string. You can run the search in multiple folders at once. So, there is no need to run the search separately for each folder:
Set olItems = olFldr.Items.Restrict(filter)
Set olArchiveItems = olArchive.Items.Restrict(filter)
You can run it once for all folders and the search is performed in the background. The key benefits of using the AdvancedSearch method in Outlook are:
The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
Full support for DASL queries (custom properties can be used for searching too). To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
You can stop the search process at any moment using the Stop method of the Search class.
Read more about the AdvancedSearch method in the Advanced search in Outlook programmatically: C#, VB.NET article.

Filter sent items outlook by address in Excel VBA

I am hoping to filter the mails in my 'sent items' folder based on the email address of my contact person, i.e. sent to but my attempts so far failed. I am trying to use the filter method in the example below.
Sub CommandButton2_Click()
Dim olApp As Object
Dim olNs As Object
Dim olFldr As Object
Dim olItems As Object
Dim emailStr As String
Dim filter As String
Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderSentMail)
Debug.Print "olFldr: " & olFldr
emailStr = "sombody#gmail.com" '(email address in Excel spreadsheet)
Debug.Print "emailStr: " & emailStr
Set olItems = olFldr.Items
`for the inbox I used SenderEmailAddress. Attempts with RecipientEmailAddress etc did not work. It would help if I knew how you can see which fields are there to search through, but I don't know how to access this information, nor can I find it on google.
filter = "[SenderEmailAddress] = '" & emailStr & "'"
Set olItems = olFldr.Items.Restrict(filter)
End sub
I figured out that the recipient Address is found here:
olSentFldr.Items.Item(1).Recipients.Item(1).Address
but this still won't work:
Debug.Print olSentFldr.Items.Item(1).Recipients.Item(1).Address filter
= (" Address = """ & emailStr & """")
Set olSentFldr2 = olSentFldr.Items.Restrict(filter)
Outlook Object Model won't let you create a subrestriction on message recipients or attachments.
You can use To/CC/BCC properties in a query, but they correspond to the PR_DISPLAY_TO/ PR_DISPLAY_CC / PR_DISPLAY_BCC MAPI properties and contain a ";" separated list of recipients and may or may not contain email addresses. Generally, they only contain display names.
Extended MAPI allows to create a subrestriction PR_MESSAGE_RECIPIENTS or PR_MESSAGE_ATTACHMENTS (create RES_SUBRESTRICTION SRestriction structure on PR_MESSAGE_RECIPIENTS and RES_OR child restriction on PR_DISPLAY_NAME, PR_EMAIL_ADDRESS, PR_SMTP_ADDRESS, etc. MAPI properties), but Extended MAPI requires C++ or Delphi.
If using Redemption (I am its author) is an option, it supports RDOFolder.Items.Find/Restrict queries on message recipients in the form of "Recipients = 'user#domain.demo'"

Extract pdf files from an email from a specific contact (sender) and different inbox address in outlook

Good morning friends,
Please, I need your help, I have 2 problems:
1.- I wanted to be able to extract pdf files but an email from a specific contact (sender)
2.- I have several inboxes, how could I set another inbox, but not the one that comes by default - here I tried the following "Set Inbox = olNs.GetDefaultFolder (onothermail#gmail.com)" but it did not work for me
Thank you very much in advance
Option Explicit
Public Sub Example()
'// Declare your Variables
Dim olNs As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim Item As Outlook.MailItem
Dim Atmt As Attachment
Dim Filter As String
Dim FilePath As String
Dim AtmtName As String
Dim i As Long
Dim objOwner As Outlook.Recipient
'// Set Inbox Reference
Set olNs = Application.GetNamespace("MAPI")
Set objOwner = olNs.CreateRecipient("secondMail#gmail.com")
Set Inbox = olNs.GetSharedDefaultFolder(objOwner)
FilePath = "C:\Users\Unity\Desktop\adjuntos\"
Filter = "[Unread] = True"
Set Items = Inbox.Items.Restrict(Filter)
'// Loop through backwards
For i = Items.Count To 1 Step -1
Set Item = Items(i)
DoEvents
If Item.Class = olMail Then
If Item.SenderEmailAddress = "senderx#gmail.com" Then
For Each Atmt In Item.Attachments
AtmtName = FilePath & Atmt.FileName
If ((InStr(Atmt.DisplayName, ".jpg") Or InStr(Atmt.DisplayName, ".zip") Or InStr(Atmt.DisplayName, ".PDF") Or InStr(Atmt.DisplayName, ".pdf"))) Then
Atmt.SaveAsFile FilePath & "\" & Atmt.DisplayName
End If
Item.UnRead = False
Next
End If
End If
Next
Set Inbox = Nothing
Set Items = Nothing
Set Item = Nothing
Set Atmt = Nothing
Set olNs = Nothing
End Sub
It seems additionally you need to check the sender's email address of the item. The MailItem.SenderEmailAddress property returns a string that represents the email address of the sender of the Outlook item.
Sub SetFlagIcon()
Dim mpfInbox As Outlook.Folder
Dim obj As Outlook.MailItem
Dim i As Integer
Set mpfInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Test")
' Loop all items in the Inbox\Test Folder
For i = 1 To mpfInbox.Items.Count
If mpfInbox.Items(i).Class = olMail Then
Set obj = mpfInbox.Items.Item(i)
If obj.SenderEmailAddress = "someone#example.com" Then
'Set the yellow flag icon
obj.FlagIcon = olYellowFlagIcon
obj.Save
End If
End If
Next
End Sub
However, iterating over all items in the folder is not really a good idea. Use the Find/FindNext or Restrict methods of the Items class. Read more about these methods in the following articles:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
Also you may use the AdvancedSearch method of the Application class helpful. See Advanced search in Outlook programmatically: C#, VB.NET for more information.
Use the Store.GetDefaultFolder method instead. It returns a Folder object that represents the default folder in the store and that is of the type specified by the FolderType argument. This method is similar to the GetDefaultFolder method of the NameSpace object. The difference is that this method gets the default folder on the delivery store that is associated with the account, whereas NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile.

Resources