How to get Outlook Mail ID Properties to Excel - Challenging Problem

[raghuram.star]

Hi,

I wish to extract outlook mail id properties to excel.

My problem is to find out the Name of the Manager with the Given Employee ID of an Subordinate
And this info is available in Outlook Email ID Properties.

For Example...
In a company, Each employee got an Employee ID as well an Email ID (both are linked in outlook)
&
Each employee got an Manager

Now I'm doing this manually, which is taking whole lot of time...

How I get the required info:
First I enter Employee ID in "To" address bar, then I get his email ID, then I double click on the email ID of employee in outlook, then I see his Employee ID in First Tab and his concern manager Name will be in second Tab.

Kindly let me know if you need any more information....

I have searched many websites but no where i could not find any help on this.... Thought it as almost impossible, but still have small hope, there will be some one who can crack this problem and help me.....

Please... Please help me....

Thanks a million in advance...

Attaching sample file with screen shots for your reference

Sample_File.xls

 

[s.ridd]

Unfortunately where I work we don't have any manager details on our exchange system so I can't really test any code, I also can't view your sample file due to not being a member of that forum. However, seeing as no one else has responded and with the above in mind there are a few possible ways of achieving this. Of these, your two most likely candidates are probably

AddressEntry.Manager.Name
ContactItem.ManagerName

where for example you might use something like (all untested)

Sub test()
Dim outApp As Object 'Application
Dim outAL As Object 'AddressList
Dim outAE As Object 'AddressEntry

    Set outApp = GetObject(, "Outlook.Application")
    Set outAL = outApp.Session.AddressLists.Item("Global Address List")
    Set outAE = outAL.AddressEntries("Joe Bloggs")
    MsgBox outAE.Manager.Name
    
'or if they are in your local contacts:
'Dim outCF As Object 'ContactFolder
'Dim outCI As Object 'ContactItem

'    Set outCF = outApp.Session.GetDefaultFolder(10)
'    Set outCI = outCF.Items("Joe Bloggs")
'    MsgBox outCI.ManagerName

End Sub

Obviously adapt to pick up the correct person as relevant. Hopefully this will be of some help.

Simon

 

[raghuram.star]

Obviously adapt to pick up the correct person as relevant. Hopefully this will be of some help.

Simon

Thank you Simon, I lost all my hopes on this, and you came to save me in this... thank you so much...
Sorry I'm not sure how to upload file here.... so given link to other forum

Program is working fine when I give Name of the Contact, But I got a different problem here...
I dont have name of the contact, but i have Employee ID or the Allias Name

I'm enclosing the image file with entire manual process I do...

Please Simon... please have a look into this...

Once again thank you so much for your time...

 

[s.ridd]

The basic code could look something like this

Sub test()
Dim outApp As Object 'Application
Dim outAL As Object 'AddressList
Dim outAE As Object 'AddressEntry

    Set outApp = GetObject(, "Outlook.Application")
    Set outAL = outApp.Session.AddressLists.Item("Global Address List")
    
    For Each outAE In outAL.AddressEntries
        Select Case outAE.AddressEntryUserType
            Case 0, 5
                    'MsgBox outAE.Manager.Name
        End Select
    Next
        
End Sub

This loops through the Global Address List and looks at each AddressEntry. The Select Case test looks at whether the entry is set up as a user. This would be one way to get every single employee and output their manager name to Excel. However it will take a while to run if you have over 20000 employees. Another option would be to use code like the one below (you could also loop this over a number or all Employee IDS)

Sub test()

Dim outApp As Object 'Application
Dim outTI As Object 'TaskItem
Dim outRec As Object 'Recipient

    Set outApp = GetObject(, "Outlook.Application")
    Set outTI = outApp.CreateItem(3)
    
    outTI.Assign
    
    Set outRec = outTI.Recipients.Add("EMP20010")
    outRec.Resolve
    If outRec.Resolved Then
        MsgBox outRec.Manager.Name
    Else
        MsgBox "Couldn't find Employee"
    End If

End Sub

Hopefully that gives you something to build on

Simon

 

[s.ridd]

Forgot to add that I am assuming that .Manager.Name worked

Also forgot to comment out the .Assign method in the second piece of code which you'll only need if you want to email the manager.

Simon

 

[raghuram.star]

Forgot to add that I am assuming that .Manager.Name worked
Also forgot to comment out the .Assign method in the second piece of code which you'll only need if you want to email the manager.
Simon

Only first program worked for me, I did get the manager name

Sub test()
Dim outApp As Object 'Application
Dim outAL As Object 'AddressList
Dim outAE As Object 'AddressEntry

    Set outApp = GetObject(, "Outlook.Application")
    Set outAL = outApp.Session.AddressLists.Item("Global Address List")
    Set outAE = outAL.AddressEntries("Raghu Ram")

    MsgBox outAE.Manager.Name

End Sub

But next two Programs are KICKING me with errors, i tried many ways changing the code, but none of them worked... Please look at these

1) The First One to get Entire Contacts List with Manager Name
Got an Error @

MsgBox outAE.Manager.Name

Run-time error '91':
Object variable or With block variable not set

2) The Second One to get Manager Name with Specified Employee ID
Got an Error @

MsgBox outRec.Manager.Name

Run-time error '438':
Object doesn't support this property or method

I'm wondering if there is some way to extract entire contact list with all properties to Excel File
However I need only few details
Employee ID, Employee Name, Concern Manager Name, Concern Manager ID

Like:
If we give Employee ID,  
          program will Fetch Employee Name, Concern Manager Name & Concern Manager ID
                  Input   >> EMP20010
                  Output >> Raghu Ram, Anil, EMP10125
&
If we give Employee Name, (Raghu Ram)
         program will Fetch Employee ID, Concern Manager Name & Concern Manager ID
                  Input   >> Raghu Ram
                  Output >> EMP20010, Anil, EMP10125

Where,
EMP10125 = Anil ==> Manager
EMP20010 = Raghu Ram ==> Subordinate

My search starts with the Employee ID and Ends with Finding Manager ID

your help is highly appreciated... you are making my life easy... thank you so much for your time....

Attaching Screen shot of Contact Fields in Outlook, hope it will help you understanding my problem... kindly have a look at this....
.

 

[s.ridd]

Again as I don't have the manager's details on our system it is difficult for me to test this code but perhaps try something like

Sub test()
Dim outApp As Object 'Application
Dim outAL As Object 'AddressList
Dim outAE As Object 'AddressEntry
Dim l As Long

    Set outApp = GetObject(, "Outlook.Application")
    Set outAL = outApp.Session.AddressLists.Item("Global Address List")

    With Sheets(1)
        .Cells(1, 1) = "Employee ID"
        .Cells(1, 2) = "Employee Name"
        .Cells(1, 3) = "Manager Name"
        .Cells(1, 4) = "Manager ID"
    End With
    
    l = 2
On Error Resume Next
    For Each outAE In outAL.AddressEntries
        Select Case outAE.AddressEntryUserType
            Case 0
                With Sheets(1)
                    .Cells(l, 1) = outAE.GetExchangeUser.Alias
                    .Cells(l, 2) = outAE.Name
                    .Cells(l, 3) = outAE.Manager.Name
                    .Cells(l, 4) = outAL.AddressEntries(outAE.Manager.Name).GetExchangeUser.Alias
                End With
                l = l + 1
        End Select
    Next
On Error GoTo 0
End Sub

This should populate the first sheet with the Emp ID, Emp Name, Manager Name and Manager ID where the details exist. If not let me know and I'll think again

Simon

 

[raghuram.star]

This should populate the first sheet with the Emp ID, Emp Name, Manager Name and Manager ID where the details exist. If not let me know and I'll think again

Simon

Thank you Simon, now I'm able to get Entire List of Outlook Contacts to Excel with the fields specified.... to my surprise, I got 2,56,000 Entries... WOW... that's really great....!! Only thing is, I have to run this code very frequently (at least twice in a week) to get latest info, which took almost 13.5 hours to get entire contact list (2,56,000 Contacts)....

Sir, I still have same request, if it is possible to search for given Employee ID, coz this would take less time, as i will be looking for Single Contact...

if you get some time... can you please re-check this program, I'm getting Run-time error '438': Object doesn't support this property or method

Sub test()


Dim outApp As Object 'Application
Dim outTI As Object 'TaskItem
Dim outRec As Object 'Recipient


    Set outApp = GetObject(, "Outlook.Application")
    Set outTI = outApp.CreateItem(3)
    
    outTI.Assign
    
    Set outRec = outTI.Recipients.Add("EMP20010")
    outRec.Resolve
    If outRec.Resolved Then
        MsgBox outRec.Manager.Name   '       ********  This is the ERROR Line
    Else
        MsgBox "Couldn't find Employee"
    End If


End Sub

Once again thank you very much, you are a true help in need...

 

[s.ridd]

Again, not having access to that field I cannot test this, but looking at the code it makes sense that it wouldn't work, does outRec.AddressEntry.Manager.Name work?

Sub test()
Dim outApp As Object 'Application
Dim outTI As Object 'TaskItem
Dim outRec As Object 'Recipient

    Set outApp = GetObject(, "Outlook.Application")
    Set outTI = outApp.CreateItem(3)
    
    outTI.Assign
    
    Set outRec = outTI.Recipients.Add("EMP20010")
    outRec.Resolve
    If outRec.Resolved Then
        MsgBox outRec.AddressEntry.Manager.Name
    Else
        MsgBox "Couldn't find Employee"
    End If
End Sub

Simon

 

[raghuram.star]

does outRec.AddressEntry.Manager.Name work?

Simon

It WORKED!!!! Thank you Simon, you literally made a part of my work life easy.... thank you so much...

With your help I have this code to get all required fields...

Sub test()
   Dim outApp As Object 'Application
   Dim outTI As Object 'TaskItem
   Dim outRec As Object 'Recipient
   Dim outAL As Object 'AddressList


    Set outApp = GetObject(, "Outlook.Application")
    Set outAL = outApp.Session.AddressLists.Item("Global Address List")
    Set outTI = outApp.CreateItem(3)
    
    outTI.Assign
    
    Set outRec = outTI.Recipients.Add("EMP20010")
    outRec.Resolve
    If outRec.Resolved Then
        MsgBox outRec.AddressEntry.Name
        MsgBox outRec.AddressEntry.Manager.Name
        MsgBox outAL.AddressEntries(outRec.AddressEntry.Manager.Name).GetExchangeUser.Alias
    Else
        MsgBox "Couldn't find Employee"
    End If
End Sub

Once Again THANK YOU SO MUCH - SIMON!!!!!!