Sending an Email to Unknown Supervisor

Hi Everyone,

I was wondering if it's possible to grab a supervisors Email address from the organization tab in outlook properties.
I'm trying to write a macro for any user at work to click a button and current workbooks get sent to their supervisor.

Any help would be appreciated.

Cade

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