PDA

View Full Version : Retrieve data from Outlook



csgcsm
03-31-2009, 03:01 PM
I'm building an Excel application that allows the user to fill in a form built on Sheet1. I have a macro that pulls the name of the logged on user from the network (not Application.UserName). Using this name I need to call Outlook to retrieve the Department the user is assigned to within our Organization. I am able to to access Outlook and find the user in the Global Address List but, I can't seem to find a way to pull the logged on user's Department.

Can anybody help?

Demosthine
04-09-2009, 09:54 AM
Good Morning.

Welcome to the Forum! Always good to have new users.

Although I don't have an answer at the moment, if you can provide a copy of your workbook, I may be able to help. I haven't done any work with the Global Address List, but I've done a fair amount of other tasks through Outlook.

I'll see what I can find out in the meantime, though.
Scott

Demosthine
04-09-2009, 10:19 AM
Morning Again.

I found your solution at another site. If you go to http://www.devnewsgroups.net/group/microsoft.public.office.developer.outlook.vba/topic61947.aspx, it shows a similar help topic and gives a link to a list of available fields. I've provided his final solution in the code below. Make sure you change the Distribution List to match your organization.


Option Explicit
Sub GetOLListMembers()
Dim olOutlookApp As Outlook.Application
Dim olNameSpace As Outlook.Namespace
Dim olAddList As Outlook.AddressList
Dim olDistList As Outlook.AddressEntry
Dim olListMember As Outlook.AddressEntry
Dim objCDOSession As MAPI.Session
Dim objCDOAE As MAPI.AddressEntry
Dim i As Integer
Dim strDLName As String
strDLName = "Your distribution list" 'Change to reflect the name of your distribution list
Set olOutlookApp = New Outlook.Application
Set olNameSpace = olOutlookApp.GetNamespace("MAPI")
Set olAddList = olNameSpace.AddressLists("Global Address List")
Set olDistList = olAddList.AddressEntries(strDLName)
Set objCDOSession = CreateObject("MAPI.Session")
objCDOSession.Logon "", "", False, False, 0
i = 2
For Each olListMember In olDistList.Members
With Worksheets("Sheet3")
.Cells(i, 1).Value = olListMember.Name
Set objCDOAE = objCDOSession.GetAddressEntry(olListMember.ID)
.Cells(i, 2).Value = _
objCDOAE.Fields.Item(CdoPR_OFFICE_LOCATION).Value
i = i + 1

End With
Next
objCDOSession.Logoff
Set objCDOAE = Nothing
Set objCDOSession = Nothing
Set olDistList = Nothing
Set olAddList = Nothing
Set olNameSpace = Nothing
Set olOutlookApp = Nothing
End Sub


Hope this helps.
Scott