在Excel中拖動Outlook GAL的腳本

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 

謝謝!! Lacey

Answer 1

.OfficeLocation是關於它:)，沒有樓層號碼屬性可用。