Pulling e-mail addresses into excel with VBA from outlook - excel

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.

Related

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

Look through 2 outlook root folders in Excel with VBA

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.

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.

Excel/Outlook VBA - select folders in different Mailboxes

I'd like to collect some email count data from Outlook using Excel VBA. In addition to my personal email, I also have access to other mailboxes account/stores(?). The label on the Outlook mailbox/accounts are HR,Marketing, Accounting. I'd like to loop through the folders in these mailboxes/stores and perform some task.
When I write a for loop through Sessions.Accounts, it only accesses my default mailbox (i.e. not HR,Marketing,Accounting). It looks like I can access my non-default mailboxes if I loop through Session.Stores:
Sub test()
Dim olApp As Outlook.Application
Set olApp = Outlook.Application
For Each acct In olApp.Session.Stores
MsgBox acct
'how can I access folders and emails within these Stores?
End Sub
This returns message boxes with HR, Marketing, Accounting. I am not able to select the inbox or other folders within these non-default mailboxes though.
For my default mailbox, I was able to get it:
Sub default_email_count()
Dim olApp As Outlook.Application
Dim objNS As Outlook.Namespace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = olbNS.GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("sample_folder")
Count = olFolder.Items.Count
Msgbox Count
'this code successfully outputs the count of emails in my default mailbox within the folder "sample folder"
How can I extend the above code to work across other Stores and not just my default mailbox?
Thanks in advance.
The following code shows how to enumerate all folders on all stores for an Outlook session.
The code sample begins by getting all the stores for the current session using the NameSpace.Stores property of the current session, Application.Session.
For each store of this session, it uses Store.GetRootFolder to obtain the folder at the root of the store.
For the root folder of each store, it iteratively calls the EnumerateFolders procedure until it has visited and displayed the name of each folder in that tree.
Sub EnumerateFoldersInStores()
Dim colStores As Outlook.Stores
Dim oStore As Outlook.Store
Dim oRoot As Outlook.Folder
On Error Resume Next
Set colStores = Application.Session.Stores
For Each oStore In colStores
Set oRoot = oStore.GetRootFolder
Debug.Print (oRoot.FolderPath)
EnumerateFolders oRoot
Next
End Sub
Private Sub EnumerateFolders(ByVal oFolder As Outlook.Folder)
Dim folders As Outlook.folders
Dim Folder As Outlook.Folder
Dim foldercount As Integer
On Error Resume Next
Set folders = oFolder.folders
foldercount = folders.Count
'Check if there are any folders below oFolder
If foldercount Then
For Each Folder In folders
Debug.Print (Folder.FolderPath)
EnumerateFolders Folder
Next
End If
End Sub
If the mailboxes are already in your profile, use the Namespace.Stores collection. Default folders can be accessed using Store.GetDefaultFolder (instead of Namespace.GetDefaultFolder).
You can also use Namespace.GetSharedDefaultFolder - it takes Recipient object as one of its parameters (you can get it from Namespace.CreateRecipient).

AppointmentItem "From" property

I have this code to create an Outlook appointment from an Excel sheet. It's working fine. But I am using 2 e-mail accounts on Outlook and I don't know how to alternate the meeting host between these accounts. What is the property of AppointmentItem Object, that changes the meeting host?
PS: Isn't "Organizer", I have already tried.
#EDIT:
I was trying to use .SendUsingAccountas suggested by Macro Man, but, still not changing the sender.
My code:
Set oApp = CreateObject("Outlook.Application")
Set ItemAppoint = oApp.CreateItem(1)
ItemAppoint.MeetingStatus = olMeeting
'===============Accounts===============
Dim Var As Object
Set Var = ItemAppoint.session.accounts
'======================================
With ItemAppoint
.SendUsingAccount = Var(2) 'The account that I want to use is the index "2"
.Subject = "Sub"
.Body = "text"
.Display
End With
The .Organizer property is read-only, you're after the .SendUsingAccount property which is read/write
AppointmentItem.SendUsingAccount
More information on the MSDN pages: AppointmentItem.SendUsingAccount Property (Outlook)
The AppointmentItem.SendUsingAccount property allows to specify an Account object that represents the account under which the AppointmentItem is to be sent.
What is the property of AppointmentItem Object, that changes the meeting host?
The easiest way is to create an appointment item in the calendar folder which belongs to a particular account. What code do you use for creating appointment items?
The How To: Create a new Outlook Appointment item article explains all possible ways for creating appointment items in Outlook. Try to get the right folder and use the Add method of the Items class. For example:
items.Add(Outlook.OlItemType.olAppointmentItem)
The GetDefaultFolder method of the Store class 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.
This works Well.
Sub Test()
Dim oNamespace As Outlook.Namespace
Dim oCalendarFolder As Outlook.MAPIFolder
Dim oItems As Outlook.items
Dim strEntryID As String
Set oOutlook = CreateObject("Outlook.Application")
Set oNamespace = oOutlook.GetNamespace("MAPI")
For Each i In oNamespace.Folders
If i.Name = "yourEmailIDhere" Then
For Each j In i.Folders
If j.Name = "Calendar" Then
strEntryID = j.EntryID
End If
Next j
End If
Next i
Set oCalendarFolder = oNamespace.GetFolderFromID(strEntryID)
oItems = oCalendarFolder.items
oMeeting = oItems.Add(Outlook.OlItemType.olAppointmentItem)
oMeeting.Save
oMeeting.Display`
End sub`
I just arrived to this question when searching for a solution to the same problem: in my case the appointment was being created for a different account than desired, and the .SendUsingAccount property was of no help.
I managed to solve this by directly creating the appointment inside the folder I wanted:
Set OutlookApp = CreateObject("Outlook.Application")
Set AppointItem = OutlookApp.GetNamespace("MAPI").Folders("secondary#hostname.com").Folders("Calendar").Items.Add(Outlook.OlItemType.olAppointmentItem)
Now the appointment is created for the secondary#hostname.com account, and not for the default#hostname.com account.

Resources