Как получить глобальный список адресов с помощью SAS - PullRequest
0 голосов
/ 29 января 2019

Можно ли извлечь подробности из списка глобальных адресов 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имя)выше детали.

1 Ответ

0 голосов
/ 29 января 2019

Я бы не предложил использовать 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;
...