title: How to retrieve Global address list using SAS
body: <p>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</p>
  
  <p>We have VBA code in place and it is talking more time to pull details, But we would like to migrate it to SAS</p>
  
  <p>We have only VBA code and it is too lengthy </p>
  
  <pre><code>Private Const xlUp As Long = -4162
  </code></pre>
  
  <p>Sub CopyGALToExcel()</p>
  
  <p>'This is an Outlook Macro</p>
  
  <p>Dim xlApp As Object</p>
  
  <p>Dim xlWB As Object</p>
  
  <p>Dim xlSheet As Object</p>
  
  <p>Dim bXStarted As Boolean</p>
  
  <p>Dim i As Long, j As Long, lastRow As Long</p>
  
  <p>Dim olApp As Outlook.Application</p>
  
  <p>Dim olNS As Outlook.NameSpace</p>
  
  <p>Dim olGAL As Outlook.AddressList</p>
  
  <p>Dim olEntry As Outlook.AddressEntries</p>
  
  <p>Dim olMember As Outlook.AddressEntry</p>
  
  <p>Set olApp = Outlook.Application</p>
  
  <p>Set olNS = olApp.GetNamespace("MAPI")</p>
  
  <p>Set olGAL = olNS.GetGlobalAddressList()</p>
  
  <p>'the path of the workbook</p>
  
  <p>strPath = "MyDrive\Vikas.xlsx"</p>
  
  <pre><code> On Error Resume Next
  
   Set xlApp = GetObject(, "Excel.Application")
  
   If Err &lt;&gt; 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
  </code></pre>
  
  <p>'clear all current entries</p>
  
  <p>xlSheet.Cells.Select</p>
  
  <p>xlApp.Selection.ClearContents</p>
  
  <p>'set and format headings in the worksheet:</p>
  
  <p>xlSheet.Cells(1, 1).Value = "OutLastName"</p>
  
  <p>xlSheet.Cells(1, 2).Value = "OutFirstName"</p>
  
  <p>xlSheet.Cells(1, 3).Value = "OutWorkPhone"</p>
  
  <p>xlSheet.Cells(1, 4).Value = "OutEmail"</p>
  
  <p>xlSheet.Cells(1, 5).Value = "OutTitle"</p>
  
  <p>xlSheet.Cells(1, 6).Value = "OutDepartment"</p>
  
  <p>xlSheet.Cells(1, 7).Value = "EmployeeID"</p>
  
  <p>xlSheet.Cells(1, 8).Value = "ManagerID"</p>
  
  <p>xlSheet.Cells(1, 9).Value = "OutOfficeLocation"</p>
  
  <p>xlSheet.Cells(1, 10).Value = "OutCompanyName"</p>
  
  <p>xlSheet.Cells(1, 11).Value = "OutAddress"</p>
  
  <p>xlSheet.Cells(1, 12).Value = "OutCity"</p>
  
  <p>xlSheet.Cells(1, 13).Value = "OutAddressEntryUserType"</p>
  
  <p>xlSheet.Cells(1, 14).Value = "OutApplication"</p>
  
  <p>xlSheet.Cells(1, 15).Value = "OutAssistantName"</p>
  
  <p>xlSheet.Cells(1, 16).Value = "OutClass"</p>
  
  <p>xlSheet.Cells(1, 17).Value = "OutComments"</p>
  
  <p>xlSheet.Cells(1, 18).Value = "OutDisplayType"</p>
  
  <p>xlSheet.Cells(1, 19).Value = "OutID"</p>
  
  <p>xlSheet.Cells(1, 20).Value = "OutMobilePhone"</p>
  
  <p>xlSheet.Cells(1, 21).Value = "OutLastFirst"</p>
  
  <p>xlSheet.Cells(1, 22).Value = "OutParent"</p>
  
  <p>xlSheet.Cells(1, 23).Value = "OutPostalCode"</p>
  
  <p>xlSheet.Cells(1, 24).Value = "OutPrimarySmtpAddress"</p>
  
  <p>xlSheet.Cells(1, 25).Value = "OutPropertyAccessor"</p>
  
  <p>xlSheet.Cells(1, 26).Value = "OutSession"</p>
  
  <p>xlSheet.Cells(1, 27).Value = "OutStateOrProvince"</p>
  
  <p>xlSheet.Cells(1, 28).Value = "OutStreetAddress"</p>
  
  <p>xlSheet.Cells(1, 29).Value = "OutType"</p>
  
  <p>xlSheet.Cells(1, 30).Value = "OutYomiCompanyName"</p>
  
  <p>xlSheet.Cells(1, 31).Value = "OutYomiDepartment"</p>
  
  <p>xlSheet.Cells(1, 32).Value = "OutYomiDisplayName"</p>
  
  <p>xlSheet.Cells(1, 33).Value = "OutYomiFirstName"</p>
  
  <p>xlSheet.Cells(1, 34).Value = "OutYomiLastName"</p>
  
  <p>End With</p>
  
  <p>Set olEntry = olGAL.AddressEntries</p>
  
  <p>On Error Resume Next</p>
  
  <p>'first row of entries</p>
  
  <p>j = 2</p>
  
  <p>' loop through dist list and extract members</p>
  
  <p>For i = 1 To olEntry.Count</p>
  
  <pre><code>Set olMember = olEntry.Item(i)
  
  If olMember.AddressEntryUserType = olExchangeUserAddressEntry Then
  
      If olMember.GetExchangeUser.Department &lt;&gt; "" And olMember.GetExchangeUser.LastName &lt;&gt; "" And olMember.GetExchangeUser.FirstName &lt;&gt; "" 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
  </code></pre>
  
  <p>GetOutlookInfoFromGWID(strGWID As String, strInfo As String)</p>
  
  <p>Dim outApp As Object 'Application
     Dim outTI As Object 'TaskItem
     Dim outRec As Object 'Recipient
     Dim outAL As Object 'AddressList</p>
  
  <pre><code>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
  </code></pre>
  
  <p>On Error GoTo ErrorHandler
          Select Case strInfo
              Case "Name"
                  'GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.name
                  GetOutlookInfoFromGWID = outRec.AddressEntry.GetExchangeUser.FirstName &amp; " " &amp; 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</p>
  
  <p>End Function</p>
  
  <p>Please help is there any way to get above details.</p>