Question

我正在使用以下脚本从excel中的全局通讯簿中提取项目所需的字段，并且它运行正常，但我想添加一个字段，其中包含个人所在的楼层编号上。有谁知道如何添加这个字段？我已尝试使用GetExchangeUser对象组的所有字段。请告诉我！我将非常感激!!

Sub GetOutlookAddressBook()

 ' Need to add reference to Outlook
 '(In VBA editor Tools References MS Outlook #.# Library)
 ' Adds addresses to existing Sheet called Address and
 ' defines name Addresses containing this list
 ' For use with data Validation ListBox (Source as =Addresses)

 On Error GoTo 0

 Dim objOutlook As Outlook.Application
 Dim objAddressList As Outlook.AddressList
 Dim objAddressEntry As Outlook.AddressEntry
 Dim lngCounter As Long

 Application.ScreenUpdating = False

 ' Setup connection to Outlook application
 Set objOutlook = CreateObject("Outlook.Application")
 Set objAddressList = objOutlook.Session.AddressLists("Global Address List")


 Application.EnableEvents = False
 'Application.DisplayAlerts = False

  ' Clear existing list
 Sheets("Address").Range("A:A").Clear

  'Step through each contact and list each that has an email address
 For Each objAddressEntry In objAddressList.AddressEntries
   If objAddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
     lngCounter = lngCounter + 1
     Application.StatusBar = "Address no. " & lngCounter & " ... " &               objAddressEntry.Address
     Sheets("Address").Cells(lngCounter, 1) = objAddressEntry.GetExchangeUser.Alias
     Sheets("Address").Cells(lngCounter, 2) = objAddressEntry.GetExchangeUser.Name
     Sheets("Address").Cells(lngCounter, 3) =    objAddressEntry.GetExchangeUser.CompanyName
     Sheets("Address").Cells(lngCounter, 4) = objAddressEntry.GetExchangeUser.Address
     Sheets("Address").Cells(lngCounter, 5) = objAddressEntry.GetExchangeUser.Department
     Sheets("Address").Cells(lngCounter, 6) = objAddressEntry.GetExchangeUser.JobTitle
     Sheets("Address").Cells(lngCounter, 7) = objAddressEntry.GetExchangeUser.OfficeLocation
     DoEvents
   End If
 Next objAddressEntry

 ' Define range called "Addresses" to the list of emails
 'Sheets("Address").Cells(1, 1).Resize(lngCounter, 1).Name = "Addresses"
  'error:
 Set objOutlook = Nothing
 Application.StatusBar = False
 Application.EnableEvents = False


End Sub

谢谢！雷斯

Answer 1

.OfficeLocation是关于它:)，没有楼层号属性。

用于在Excel中提取Outlook GAL的脚本

1 个答案: