How to retrieve Global address list using SAS - outlook

Question

Is there any way to extract Outlook Global address list details using SAS. I would need Associate details and his manager email address. Please assist
We have VBA code in place and it is talking more time to pull details, But we would like to migrate it to SAS
We have only VBA code and it is too lengthy
Private Const xlUp As Long = -4162
Sub CopyGALToExcel()
'This is an Outlook Macro
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim bXStarted As Boolean
Dim i As Long, j As Long, lastRow As Long
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olGAL As Outlook.AddressList
Dim olEntry As Outlook.AddressEntries
Dim olMember As Outlook.AddressEntry
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olGAL = olNS.GetGlobalAddressList()
'the path of the workbook
strPath = "MyDrive\Vikas.xlsx"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")
'Find the next empty line of the worksheet
'clear all current entries
xlSheet.Cells.Select
xlApp.Selection.ClearContents
'set and format headings in the worksheet:
xlSheet.Cells(1, 1).Value = "OutLastName"
xlSheet.Cells(1, 2).Value = "OutFirstName"
xlSheet.Cells(1, 3).Value = "OutWorkPhone"
xlSheet.Cells(1, 4).Value = "OutEmail"
xlSheet.Cells(1, 5).Value = "OutTitle"
xlSheet.Cells(1, 6).Value = "OutDepartment"
xlSheet.Cells(1, 7).Value = "EmployeeID"
xlSheet.Cells(1, 8).Value = "ManagerID"
xlSheet.Cells(1, 9).Value = "OutOfficeLocation"
xlSheet.Cells(1, 10).Value = "OutCompanyName"
xlSheet.Cells(1, 11).Value = "OutAddress"
xlSheet.Cells(1, 12).Value = "OutCity"
xlSheet.Cells(1, 13).Value = "OutAddressEntryUserType"
xlSheet.Cells(1, 14).Value = "OutApplication"
xlSheet.Cells(1, 15).Value = "OutAssistantName"
xlSheet.Cells(1, 16).Value = "OutClass"
xlSheet.Cells(1, 17).Value = "OutComments"
xlSheet.Cells(1, 18).Value = "OutDisplayType"
xlSheet.Cells(1, 19).Value = "OutID"
xlSheet.Cells(1, 20).Value = "OutMobilePhone"
xlSheet.Cells(1, 21).Value = "OutLastFirst"
xlSheet.Cells(1, 22).Value = "OutParent"
xlSheet.Cells(1, 23).Value = "OutPostalCode"
xlSheet.Cells(1, 24).Value = "OutPrimarySmtpAddress"
xlSheet.Cells(1, 25).Value = "OutPropertyAccessor"
xlSheet.Cells(1, 26).Value = "OutSession"
xlSheet.Cells(1, 27).Value = "OutStateOrProvince"
xlSheet.Cells(1, 28).Value = "OutStreetAddress"
xlSheet.Cells(1, 29).Value = "OutType"
xlSheet.Cells(1, 30).Value = "OutYomiCompanyName"
xlSheet.Cells(1, 31).Value = "OutYomiDepartment"
xlSheet.Cells(1, 32).Value = "OutYomiDisplayName"
xlSheet.Cells(1, 33).Value = "OutYomiFirstName"
xlSheet.Cells(1, 34).Value = "OutYomiLastName"
End With
Set olEntry = olGAL.AddressEntries
On Error Resume Next
'first row of entries
j = 2
' loop through dist list and extract members
For i = 1 To olEntry.Count
Set olMember = olEntry.Item(i)
If olMember.AddressEntryUserType = olExchangeUserAddressEntry Then
If olMember.GetExchangeUser.Department <> "" And olMember.GetExchangeUser.LastName <> "" And olMember.GetExchangeUser.FirstName <> "" Then
'add to worksheet
xlSheet.Cells(j, 1).Value = olMember.GetExchangeUser.LastName
xlSheet.Cells(j, 2).Value = olMember.GetExchangeUser.FirstName
xlSheet.Cells(j, 3).Value = olMember.GetExchangeUser.BusinessTelephoneNumber
xlSheet.Cells(j, 4).Value = olMember.GetExchangeUser.PrimarySmtpAddress
xlSheet.Cells(j, 5).Value = olMember.GetExchangeUser.JobTitle
xlSheet.Cells(j, 6).Value = olMember.GetExchangeUser.Department
xlSheet.Cells(j, 7).Value = olMember.GetExchangeUser.Alias
If IsNull(olMember.Manager.Alias) Or olMember.Manager.Alias = "" Then
strMgrID = GetOutlookInfoFromGWID(olMember.GetExchangeUser.Alias, "ManagerId")
If IsNull(strMgrID) Or strMgrID = "" Or strMgrID = "Not Found" Then
xlSheet.Cells(j, 8).Value = olMember.GetExchangeUser.GetExchangeUserManager.Alias
Else
xlSheet.Cells(j, 8).Value = strMgrID
End If
Else
xlSheet.Cells(j, 8).Value = olMember.Manager.Alias
End If
xlSheet.Cells(j, 9).Value = olMember.GetExchangeUser.OfficeLocation
xlSheet.Cells(j, 10).Value = olMember.GetExchangeUser.CompanyName
xlSheet.Cells(j, 11).Value = olMember.GetExchangeUser.Address
xlSheet.Cells(j, 12).Value = olMember.GetExchangeUser.City
xlSheet.Cells(j, 13).Value = olMember.GetExchangeUser.AddressEntryUserType
xlSheet.Cells(j, 14).Value = olMember.GetExchangeUser.Application
xlSheet.Cells(j, 15).Value = olMember.GetExchangeUser.AssistantName
xlSheet.Cells(j, 16).Value = olMember.GetExchangeUser.Class
xlSheet.Cells(j, 17).Value = olMember.GetExchangeUser.Comments
xlSheet.Cells(j, 18).Value = olMember.GetExchangeUser.DisplayType
xlSheet.Cells(j, 19).Value = olMember.GetExchangeUser.ID
xlSheet.Cells(j, 20).Value = olMember.GetExchangeUser.MobileTelephoneNumber
xlSheet.Cells(j, 21).Value = olMember.GetExchangeUser.Name
xlSheet.Cells(j, 22).Value = olMember.GetExchangeUser.Parent
xlSheet.Cells(j, 23).Value = olMember.GetExchangeUser.PostalCode
xlSheet.Cells(j, 24).Value = olMember.GetExchangeUser.PrimarySmtpAddress
xlSheet.Cells(j, 25).Value = olMember.GetExchangeUser.PropertyAccessor
xlSheet.Cells(j, 26).Value = olMember.GetExchangeUser.Session
xlSheet.Cells(j, 27).Value = olMember.GetExchangeUser.StateOrProvince
xlSheet.Cells(j, 28).Value = olMember.GetExchangeUser.StreetAddress
xlSheet.Cells(j, 29).Value = olMember.GetExchangeUser.Type
xlSheet.Cells(j, 30).Value = olMember.GetExchangeUser.YomiCompanyName
xlSheet.Cells(j, 31).Value = olMember.GetExchangeUser.YomiDepartment
xlSheet.Cells(j, 32).Value = olMember.GetExchangeUser.YomiDisplayName
xlSheet.Cells(j, 33).Value = olMember.GetExchangeUser.YomiFirstName
xlSheet.Cells(j, 34).Value = olMember.GetExchangeUser.YomiLastName
j = j + 1
Else
j = j
End If
GetOutlookInfoFromGWID(strGWID As String, strInfo As String)
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(strGWID)
outRec.Resolve
If outRec.Resolved Then
On Error GoTo ErrorHandler
Select Case strInfo
Case "Name"
'GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.name
GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.FirstName & " " & outRec.AddressEntry.GetExchangeUser.LastName
Case "Phone"
GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.BusinessTelephoneNumber
Case "Email"
GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.PrimarySmtpAddress
Case "ManagerId"
GetOutlookInfoFromGWID = outAL.AddressEntries(outRec.AddressEntry.Manager.Name).GetExchangeUser.Alias
Case "ManagerName"
GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.Manager.Name
Case "ManagerProperties"
'GetOutlookInfoFromGWID = outAL.AddressEntries(outRec.AddressEntry.Manager.name).GetExchangeUser.Alias
Case Else
ErrorHandler:
GetOutlookInfoFromGWID = "x"
Resume Next
End Select
Else
GetOutlookInfoFromGWID = "Not Found"
End If
End Function
Please help is there any way to get above details.

Answer 1

What I would suggest is not use Outlook for this operation. Outlook is a client tool to display information. In a company, this information normally comes from Active Directory which is a variant of LDAP. Hence, treat the address book as a database and ignore Outlook.
For code that reads that database, look at the following code:
%let LDAPServer = "ADC21039.ms.ds.ABC.com";
%let LDAPPort = 389;
%let BaseDN = "CN=Users,DC=ms,DC=ds,DC=ABC,DC=com";
%let BindUserDN = "CN=achurc1,CN=Users,DC=ms,DC=ds,DC=ABC,DC=com";
%let BindUserPW = "PASSWORD";
%let Filter = "(objectClass=person)";
%let Attrs= "cn sn";
data _null_;
length entryname $200 attrName $100 value $100 filter $110;
rc =0; handle =0;
server=&LDAPServer;
port=&LDAPPort;
base=&BaseDN;
bindDN=&BindUserDN;
Pw=&BindUserPW;
/* open connection to LDAP server */
call ldaps_open(handle, server, port, base, bindDn, Pw, rc);
if rc ne 0 then do;
put "LDAPS_OPEN call failed.";
msg = sysmsg();
put rc= / msg;
end;
else
put "LDAPS_OPEN call successful.";
shandle=0;
num=0;
filter=&Filter;
/* search and return attributes for objects */
attrs=&Attrs;
/* search the LDAP directory */
call ldaps_search(handle,shandle,filter, attrs, num, rc);
if rc ne 0 then do;
put "LDAPS_SEARCH call failed.";
msg = sysmsg();
put rc= / msg;
end;
else do;
put " ";
put "LDAPS_SEARCH call successful.";
put "Num entries returned is " num;
put " ";
end;
do eIndex = 1 to num;
numAttrs=0;
entryname='';
/* retrieve each entry name and number of attributes */
call ldaps_entry(shandle, eIndex, entryname, numAttrs, rc);
if rc ne 0 then do;
put "LDAPS_ENTRY call failed.";
msg = sysmsg();
put rc= / msg;
end;
else do;
put " ";
put "LDAPS_ENTRY call successful.";
put "Num attributes returned is " numAttrs;
end;
/* for each attribute, retrieve name and values */
do aIndex = 1 to numAttrs;
attrName='';
numValues=0;
call ldaps_attrName(shandle, eIndex, aIndex, attrName, numValues, rc);
if rc ne 0 then do;
msg = sysmsg();
put rc= / msg;
end;
else do;
put " ";
put " ATTRIBUTE name : " attrName;
put " NUM values returned : " numValues;
end;
do vIndex = 1 to numValues;
call ldaps_attrValue(shandle, eIndex, aIndex, vIndex, value, rc);
if rc ne 0 then do;
msg = sysmsg();
put rc= / msg;
end;
else do;
put " Value : " value;
output;
end;
end;
end;
end;
/* free search resources */
put /;
call ldaps_free(shandle,rc);
if rc ne 0 then do;
put "LDAPS_FREE call failed.";
msg = sysmsg();
put rc= / msg;
end;
else
put "LDAPS_FREE call successful.";
/* close connection to LDAP server */
put /;
call ldaps_close(handle,rc);
if rc ne 0 then do;
put "LDAPS_CLOSE call failed.";
msg = sysmsg();
put rc= / msg;
end;
else
put "LDAPS_CLOSE call successful.";
run;