try this (you would need to change "last name first name" for each of the users with their full name (last name first name format)
also, before attaching the current file, it must be saved.
![]()
Sub SendEmailToManager() On Error Resume Next Dim I As Integer Dim ToAddr As String Dim ActivePersonVerified As Boolean Dim ol As Outlook.Application Dim DummyEMail As MailItem Dim ActivePersonRecipient As Recipient Dim oAE As Outlook.AddressEntry Dim oExUser As Outlook.ExchangeUser Dim oPA As Outlook.PropertyAccessor Dim strManager As String 'code taken from: 'http://social.msdn.microsoft.com/Forums/office/en-US/183a9b77-7f5a-4afc-91e6-fbe2914c5f78/extract-data-from-the-global-address-book-with-vba?forum=outlookdev 'Instantiate Outlook Set ol = CreateObject("Outlook.Application") 'E-mail aliases are in a named range "aliasrange" 'Assign the named range to a range object 'Create a dummy e-mail to add aliases to Set DummyEMail = ol.CreateItem(olMailItem) 'Assign the current alias to a variable ToAddr ToAddr = "last name first name" ' enter the user's name 'Use the alias to create a recipient object and add it to the dummy e-mail Set ActivePersonRecipient = DummyEMail.Recipients.Add(ToAddr) ActivePersonRecipient.Type = olTo 'Resolve the recipient to ensure it is valid ActivePersonVerified = ActivePersonRecipient.Resolve 'If valid, use the AddressEntry property of the recipient to return an AddressEntry object If ActivePersonVerified Then Set oAE = ActivePersonRecipient.AddressEntry 'Use the GetExchangeUser method of the AddressEntry object to retrieve the ExchangeUser object for the recipient. Set oExUser = oAE.GetExchangeUser 'Write the properties of the ExchangeUser object to adjacent columns on the worksheet. ActivePersonRecipient.Delete 'Remove the recipient from the e-mail ToAddr = oExUser.Manager Set ActivePersonRecipient = DummyEMail.Recipients.Add(ToAddr) ActivePersonRecipient.Type = olTo 'Resolve the recipient to ensure it is valid ActivePersonVerified = ActivePersonRecipient.Resolve Set oAE = ActivePersonRecipient.AddressEntry Set oExUser = oAE.GetExchangeUser ToAddr = oExUser.PrimarySmtpAddress End If DummyEMail.Display DummyEMail.Subject = "for my manager" DummyEMail.Body = "please review the attachment" DummyEMail.Attachments.Add ActiveWorkbook.FullName ExitOutlookEmail: Set DummyEMail = Nothing Set ol = Nothing End Sub
Bookmarks