I was trying to figure out how to use late binding in an excel module to retrieve the current user's email address for 'auto-emailing' upon execution of a macro.
I'll post the solution below. I am using Excel 2010 but it works on 2013 as well.
Dim OL, olAllUsers, oExchUser, oentry, myitem As Object
Dim User As String
Set OL = CreateObject("outlook.application")
Set olAllUsers = OL.Session.AddressLists.Item("All Users").AddressEntries
User = OL.Session.CurrentUser.Name
Set oentry = olAllUsers.Item(User)
Set oExchUser = oentry.GetExchangeUser()
msgbox oExchUser.PrimarySmtpAddress
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
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.
I've a custom VBA function in Excel that's supposed to pick up the associated Office user's email address. It triggers arbitrarily for some users - sometimes it works, other times it doesn't.
My end-users aren't all on the latest version of Excel, but this is the only VBA function that's causing trouble. For affected users it tends to work more the first time they open the file, and then goes inert on subsequent opens.
Function UserName() As String
Dim OL As Object, olAllUsers As Object, oExchUser As Object, oentry As Object, myitem As Object
Dim User As String
Set OL = CreateObject("outlook.application")
Set olAllUsers = OL.Session.AddressLists.Item("All Users").AddressEntries
User = OL.Session.CurrentUser.Name
Set oentry = olAllUsers.Item(User)
Set oExchUser = oentry.GetExchangeUser()
UserName = oExchUser.PrimarySmtpAddress
End Function
I tried some solutions from the web to no avail, as well as trying to force the cell to recalculate, but it seems that for impacted users once the function has decided it doesn't do anything, recalculation is irrelevant.
The code can be simplified a bit:
Function UserName() As String
Dim OL As Object, oExchUser As Object, oentry As Object, myitem As Object
Dim User As String
Set OL = CreateObject("outlook.application")
'
' use NameSpace.Logon if required
'
Set oentry = OL.Session.CurrentUser.AddressEntry
'
' here you can also check whether it is an Exchange account
'
Set oExchUser = oentry.GetExchangeUser()
UserName = oExchUser.PrimarySmtpAddress
End Function
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.