有没有办法使用 SAS 提取 Outlook 全局地址列表详细信息。我需要同事的详细信息和他的经理的电子邮件地址。请帮忙
我们已经有了 VBA 代码，正在讨论更多时间来提取细节，但我们想将其迁移到 SAS
我们只有VBA代码，而且太长了
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
请帮忙有什么方法可以获取以上详细信息。
我建议不要使用 Outlook 进行此操作。 Outlook是一个显示信息的客户端工具。在公司中，此信息通常来自 Active Directory，它是 LDAP 的变体。因此，将通讯录视为数据库并忽略 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;