Можно ли извлечь подробности из списка глобальных адресов Outlook с помощью SAS.Мне понадобятся данные сотрудника и его адрес электронной почты менеджера.Помогите, пожалуйста,
У нас есть код VBA, и нам нужно больше времени, чтобы узнать подробности, но мы хотели бы перенести его на SAS
У нас есть только код VBA, и он слишком длинный
Private Const xlUp As Long = -4162
Sub CopyGALToExcel ()
'Это макрос Outlook
Dim xlApp As Object *
Dim xlWB As Object
Dim xlSheet As Object
Dim bXStarted As Boolean
Dim i As Long, j 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
Установить 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.Ячейки (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.Ячейки (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.Ячейки (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.Ячейки (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 As String, strInfo AsString)
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
При ошибке GoTo ErrorHandler Выбрать случай strInfo Case "Имя "'GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.nameGetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.GetOutlookInfoFromGWID = outAL.AddressEntries (outRec.AddressEntry.Manager.Name) .GetExchangeUser.Alias Case "ManagerName" GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.Manager.Name outressAAEимя)выше детали.