In Excel version 2201, using VBA, I would like to get the PrimarySMTP property for a list of mail users for which I have the display name.
I have written code that works in most cases:
Set myolApp = CreateObject("Outlook.Application")
Set myNameSpace = myolApp.GetNamespace("MAPI")
Set MyAddrList = myNameSpace.addressLists("Global Address List")
Set myAddrEntries = MyAddrList.AddressEntries(strDisplayname)
Set objExchUsr = myAddrEntries.GetExchangeUser
PrimarySMTP=objExchUsr.PrimarySMTPAddress
The problem arises when sometimes for a display name there is more than one result: GetExchangeUser does not retrieve the PrimarySMTP of the correct person.
I tried passing to the AddressEntries function the UPN, instead of the Display Name, but with no success.
If the recipient name is ambiguous, Recipient.Resolve will fail.
You cannot resolve ambiguous names using Outlook Object Model - you can loop through all GAL entries, but that will be too slow and will fail for large GAL containers.
In Extended MAPI (C++ or Delphi), you can use PR_ANR restriction to get all matches (that is what Outlook uses to show the list of ambiguous entries).
If using Redemption (I am its author) is an option, you can use RDOSession.AddressBook.GAL.ResolveNameEx
set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = myolApp.Session.MAPIOBJECT
set AdrrEntries = Session.AddressBook.GAL.ResolveNameEx(strDisplayname)
Debug.Print AdrrEntries.Count & " names were returned by ResolveNameEx:"
Debug.Print "------------"
for each AE in AdrrEntries
Debug.Print AE.Name
next
Debug.Print "------------"
The Outlook object model provides the NameSpace.CreateRecipient method which creates a Recipient object. It is used to verify a given name against an address book. The name of the recipient can be a string representing the display name, the alias, or the full SMTP email address of the recipient.
Sub ResolveName()
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Dim CalendarFolder As Outlook.Folder
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("Eugene Astafiev")
myRecipient.Resolve
If myRecipient.Resolved Then
Set objExchUsr = myRecipient.AddressEntry.GetExchangeUser()
PrimarySMTP = objExchUsr.PrimarySMTPAddress
Else
' you need to iterate over all entries in the AB
End If
End Sub
The Outlook object model doesn't provide anything else for that.
Related
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.
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
I have two columns with headers To and Cc.
I need to extract To and Cc email addresses, not name, into the Excel file from Outlook.
Sub ExportOutlookInfo()
Dim o As Outlook.Application
Set o = New Outlook.Application
Dim ons As Outlook.Namespace
Set ons = o.GetNamespace("MAPI")
Dim omail As Outlook.MailItem
Set omail = o.CreateItem(olMailItem)
Dim i As Long
Dim olRecip As Outlook.Recipient
Dim olRecipAddress As String
Dim SENT_FLDR As MAPIFolder
Dim Items As Outlook.Items
Set SENT_FLDR = ons.GetDefaultFolder(olFolderSentMail)
Set Items = SENT_FLDR.Items
Dim recp As Outlook.Application
For i = Items.Count To 1 Step -1
DoEvents
For Each olRecip In Items(i).Recipients
Debug.Print olRecip.Address
Next olRecip
Next i
End Sub
Use the Recipients property of the MailItem class to get recipient email addresses. The Using Outlook Recipient and Recipients collection – guide for developers article explains how to deal with recipients. If you need to get the recipient's email address you may use the following sequence of calls:
Recipient.AddressEntry.Address
The Address property of the AddressEntry class returns a string representing the e-mail address of the AddressEntry.
Also you may find the GetExchangeUser method of the AddressEntry class which returns an ExchangeUser object that represents the AddressEntry if the AddressEntry belongs to an Exchange AddressList object such as the Global Address List (GAL) and corresponds to an Exchange user. The ExchangeUser class provides the PrimarySmtpAddress property which I suppose you are looking for. Read more about converting email address in the HowTo: Convert Exchange-based email address into SMTP email address article.
There is another way of getting SMTP addresses of the recipients. The following GetSMTPAddressForRecipients method takes a MailItem as an input argument and then displays the SMTP address of each recipient for that mail item. The method first retrieves the Recipients collection that represents the set of recipients specified for the mail item. For each Recipient in that Recipients collection, the method then obtains the PropertyAccessor object that corresponds to that Recipient object, and uses the PropertyAccessor to get the value of the MAPI property https://schemas.microsoft.com/mapi/proptag/0x39FE001E, that maps to the SMTP address of the recipient.
Sub GetSMTPAddressForRecipients(mail As Outlook.MailItem)
Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
Const PR_SMTP_ADDRESS As String = _
"http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
Set recips = mail.Recipients
For Each recip In recips
Set pa = recip.PropertyAccessor
Debug.Print recip.name & " SMTP=" _
& pa.GetProperty(PR_SMTP_ADDRESS)
Next
End Sub
Assuming you are accessing the To and CC properties (which contain ; separated lists of display names which may or may not contain email addresses), you need to extract the addresses one at a time - loop through the MailItem.Recipients collection, then for each Recipient object, check the Recipient.Type property (can be olTo, olCC, olBCC). You can then read the Recipient.Address property.
Note that for Exchange recipients (address type of "EX" instead of "SMTP"), you will end up with EX addresses. If you always want an SMTP address, check that you have the right address type by reading the PR_ADDRTYPE (DASL name "http://schemas.microsoft.com/mapi/proptag/0x3002001F") MAPI property using Recipient.PropertyAccessor.GetProperty. If it is "SMTP", Recipient.Address property is all you need. If it is "EX", try to read the PR_SMTP_ADDRESS MAPI property (DASL name "http://schemas.microsoft.com/mapi/proptag/0x39FE001F"). If it is missing, your last resort will be Recipient.AddressEntry.GetExchangeUser().PrimarySmtpAddress (expensive and can raise an error).
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'"
I've an existing promotional mail with HTML formatting, colors, bullets etc. I would like to forward this mail to new set of recipients using VBA.
I've an existing mail with following Body:
Hi XXnameXX,
Some Picture are present & Lot of colored formatting.
Thanks for registering to our website. Your user id is XXuseridXX.
Thank you.
Here XXnameXX should be replaced with FirstName and XXuseridXX with userID
I am able to forward the selected mail from Outlook. But it's not forwarding it with all the images/formatting/bullets. On receiving end its showing a complete different mail with link and all.
Sub ForwardEmail()
Dim oApp As Outlook.Application
Dim objFolder As Outlook.MAPIFolder
Set oApp = New Outlook.Application
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
Dim oEmail As Outlook.MailItem
For Each objitem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objitem.Class = olMail Then
Set myforward = objitem.Forward
Set objRecip = myforward.Recipients.Add("firstlastname#gmail.com")
myforward.HTMLBody = Replace(myforward.HTMLBody, "xxnamexx", "FirstName", 1, 1)
myforward.Send
End If
End If
Next
End Sub
First of all, don't use multiple dots in the single line of code. I'd recommend breaking the chain of calls and declare each property or method call on separate lines of code.
If objFolder.DefaultItemType = olMailItem Then
There is no need to check out the folder's property in the loop each time. I'd suggest moving that condition out of the loop.
objitem.BodyFormat = olFormatHTML
Why do you need to set up the BodyFormat property? Did have a chance to check the value before setting the property?
myforward.Body = Replace(myforward.Body, "xxnamexx", "FirstName", 1, 1)
The Body property is a string representing the clear-text body of the Outlook item. You need to use the HTMLBody property if you want to preserve the formatting. You can read more about all possible ways of working with item bodies in the Chapter 17: Working with Item Bodies.
Anyway, I don't see the code where you add images and other information to the message body.