是否可以使用SAS提取Outlook全局地址列表详细信息。我需要助理详细信息和他的经理电子邮件地址。请协助
我们已经有了VBA代码，正在谈论更多的时间来获取详细信息，但是我们希望将其迁移到SAS
我们只有VBA代码，而且太长了
Private Const xlUp As Long = -4162
Sub CopyGALToExcel（）
“这是一个Outlook宏
将xlApp设为对象
将xlWB视作对象
将xlSheet设为对象
将bXStarted设为布尔值
我尽可能长，我尽可能长，最后一行一样长
将olApp设置为Outlook.Application
将OLNS设置为Outlook.NameSpace
将olGAL设为Outlook.AddressList
将olEntry设为Outlook.AddressEntries
将olMember设置为Outlook.AddressEntry
设置olApp = Outlook.Application
设置olNS = olApp.GetNamespace（“ MAPI”）
设置olGAL = olNS.GetGlobalAddressList（）
'工作簿的路径
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
'清除所有当前条目
xlSheet.Cells.Select
xlApp.Selection.ClearContents
在工作表中设置和设置标题格式：
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”
结尾为
设置olEntry = olGAL.AddressEntries
错误恢复下一个
“第一行条目
j = 2
'遍历dist列表并提取成员
对于i = 1 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为字符串，strInfo为字符串）
将outApp视作对象'Application 调出outTI作为对象'TaskItem Dim outRec作为对象“收件人” 将Dim outAL作为对象'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
出现错误时转到To ErrorHandler 选择案例strInfo 案例“名称” 'GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.name GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.FirstName＆“＆outRec.AddressEntry.GetExchangeUser.LastName 案例“电话” GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.BusinessTelephoneNumber 案例“电子邮件” GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.PrimarySmtpAddress 案例“ ManagerId” GetOutlookInfoFromGWID = outAL.AddressEntries（outRec.AddressEntry.Manager.Name）.GetExchangeUser.Alias 案例“ ManagerName” GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.Manager.Name 案例“ ManagerProperties” 'GetOutlookInfoFromGWID = outAL.AddressEntries（outRec.AddressEntry.Manager.name）.GetExchangeUser.Alias 其他情况 ErrorHandler： GetOutlookInfoFromGWID =“ x” 继续下一个 结束选择 其他 GetOutlookInfoFromGWID =“未找到” 如果结束
结束功能
请帮助您以任何方式获取上述详细信息。
答案 0 :(得分：2)
我建议不要将Outlook用于此操作。 Outlook是用于显示信息的客户端工具。在公司中，此信息通常来自LDAP的变体Active Directory。因此，请将通讯录视为数据库，而忽略Outlook。
对于读取该数据库的代码，请查看以下代码：
%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;