Solved

outlook extract from active directory

Posted on 2015-01-06
12
171 Views
Last Modified: 2015-01-20
Hello
I need help in this outlook vba piece. I have a contact group in outlook  that has several individual contact emails . How can loop through each contact in the contact group and extract out the name, position of the individual?
Thank you
0
Comment
Question by:Rayne
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 5
12 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 40533837
Hi, Rayne.

Assuming that you have Outlook 2007 or later, then this should do it.

Sub Parse_AD_DL(strAddress As String)
    Dim olkRec As Outlook.Recipient, olkAE As Outlook.AddressEntry, olkDL As Outlook.ExchangeDistributionList, olkMem As Outlook.AddressEntry
    Set olkRec = Session.CreateRecipient(strAddress)
    olkRec.Resolve
    Set olkAE = olkRec.AddressEntry
    Set olkDL = olkAE.GetExchangeDistributionList
    For Each olkMem In olkDL.Members
        'Your code goes here for processing the members in the list
        Debug.Print olkMem.Name
    Next
    Set olkDL = Nothing
    Set olkAE = Nothing
    Set olkRec = Nothing
End Sub

Open in new window


You'll need to pass the address of the list you want to process to the sub.
0
 

Author Comment

by:Rayne
ID: 40533852
Hello BlueDevilFan,

I created the contact group locally in my outlook new items >> more items >> contact group,

 i didn't create a distribution list within the outlook server - will that work then?
0
 

Author Comment

by:Rayne
ID: 40533854
and i want to loop through contact group...
0
SharePoint Admin?

Enable Your Employees To Focus On The Core With Intuitive Onscreen Guidance That is With You At The Moment of Need.

 
LVL 76

Expert Comment

by:David Lee
ID: 40534057
No, the code I posted is for a distribution list in Active Directory, which is what you'd asked for.  I can put together the code for a dist list in Outlook if that's what you need.  I don't understand your last comment, "loop through contact group".  Do you mean you want to loop through the members of the group?  If so, what do you want to do with each member?
0
 

Author Comment

by:Rayne
ID: 40534119
its not a distribution list in outlook server but i created one contact group  in my outlook like attached image....
contactGroup.bmp
0
 

Author Comment

by:Rayne
ID: 40534120
i need to get the name, title/position of the contacts
0
 

Author Comment

by:Rayne
ID: 40534122
Do you mean you want to loop through the members of the group?  I
YES
0
 
LVL 76

Expert Comment

by:David Lee
ID: 40534643
What do you want to do with the name and title of each contact?  Display it on screen, write it to a file, ...?
0
 

Author Comment

by:Rayne
ID: 40545853
Hello BluedevilFan,
Sorry for the delay, some personal issues happened.

so for each member, get his title/position and name and put it in a excel sheet
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 40546675
Please try this version.

Sub Parse_AD_DL(strAddress As String)
    Dim olkRec As Outlook.Recipient, _
        olkAE As Outlook.AddressEntry, _
        olkDL As Outlook.ExchangeDistributionList, _
        olkMem As Outlook.AddressEntry, _
        olkUsr As Outlook.ExchangeUser, _
        excApp As Object, _
        excWkb As Object, _
        excWks As Object, _
        lngRow As Long
    Set olkRec = Session.CreateRecipient(strAddress)
    olkRec.Resolve
    If olkRec.Resolved Then
        Set excApp = CreateObject("Excel.Application")
        Set excWkb = excApp.Workbooks.Add
        Set excWks = excWkb.Worksheets(1)
        With excWks
            .Cells(1, 1) = "Title/Position"
            .Cells(1, 2) = "Name"
        End With
        lngRow = 2
        Set olkAE = olkRec.AddressEntry
        Set olkDL = olkAE.GetExchangeDistributionList
        For Each olkMem In olkDL.Members
            Set olkUsr = olkMem.GetExchangeUser
            excWks.Cells(lngRow, 1) = olkUsr.JobTitle
            excWks.Cells(lngRow, 2) = olkUsr.Name
            lngRow = lngRow + 1
        Next
        excWks.Columns("A:B").AutoFit
        excWkb.SaveAs Environ("USERPROFILE") & "\Documents\" & strAddress & ".xlsx"
        excWkb.Close False
    End If
    Set olkRec = Nothing
    Set olkAE = Nothing
    Set olkDL = Nothing
    Set olkMem = Nothing
    Set olkUsr = Nothing
    Set excWks = Nothing
    Set excWkb = Nothing
    Set excApp = Nothing
    Set olkRec = Nothing
End Sub

Open in new window

0
 

Author Closing Comment

by:Rayne
ID: 40554573
thank you Bluedevilfan :)
0
 
LVL 76

Expert Comment

by:David Lee
ID: 40561199
You're welcome!
0

Featured Post

Salesforce Has Never Been Easier

Improve and reinforce salesforce training & adoption using WalkMe's digital adoption platform. Start saving on costly employee training by creating fast intuitive Walk-Thrus for Salesforce. Claim your Free Account Now

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Large Outlook files lead to various unwanted errors and corruption issues. Furthermore, large outlook files can also make Outlook take longer to start-up, search, navigate, and shut-down. So, In this article, i will discuss a method to make your Out…
When you have clients or friends from around the world, it becomes a challenge to arrange a meeting or effectively manage your time. This is where Outlook's capability to show 2 time zones in one calendar comes in handy.
This video shows where to find templates, what they are used for, and how to create and save a custom template using Microsoft Word.
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

740 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question