CODE-使用Outlook VBA列出所有人員信箱
11 |
需求是這樣的,我想出一份清單,列出所有公司同仁的Email清單,以校正資料庫中的記錄是否有誤。爬了文,發現有好幾種做法可以實踐這個需求: ADSI、WebDAV、Get-GlobalAddressList PowerShell cmdlet...
PowerShell cmdlet應是Exchange 2007時代解決此類問題的王道,不過由於必須在Exchange主機上執行,得協調有管理權限的同事代勞。心念一轉,既然Outlook可以看得到全公司的人員信箱,就應可用程式取出來。
拼湊了一下,程式還挺好寫的: 取得"全域通訊清單"(Global Address List),列舉AddressEntry,透過GetExchangeUser()就能取得連絡人詳細資料就搞定了。
Sub ListGAL()
Dim oGAL As AddressList
Set oGAL = GetObject("", "Outlook.application").GetNamespace("MAPI") _
.AddressLists.Item("全域通訊清單")
Dim oEntry As AddressEntry, oExchUser As ExchangeUser
Open "B:\AllEmailList.txt" For Output As #1
For Each oEntry In oGAL.AddressEntries
If oEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
Set oExchUser = oEntry.GetExchangeUser()
Print #1, oExchUser.Alias; ",";
Print #1, oExchUser.name; ",";
Print #1, oExchUser.PrimarySmtpAddress
End If
Next
Close #1
End Sub
另外還有件事值得一提: 用程式存取通訊錄時,Outlook會發出警示,需要人工點選放行,程式才能繼續。由於很多巨集病毒/蠕蟲都是用同樣的方式"盜取"通訊錄做壞事(電子時代,通訊錄的重要性不亞於清朝未年的"黨員名冊"呀!),這層安全鎖確有其必要性,大家平時看到,別糊里糊塗就按允許哦!
Comments
# by Iter
Set oGAL = GetObject("", "Outlook.application").GetNamespace("MAPI") _ .AddressLists.Item("全域通訊清單") 運行到這個有exception,請問你用的是VS幾“?
# by Jeffrey
to lter, 範例為Outlook VBA,是寫在Outlook 2007裡的巨集程式
# by 953904
你好, 我們公司有一個欄位名稱為"工號",抓不到此欄資料,感覺此欄並不是預設就有的欄位(註),像是公司內部自訂的資料欄位,要如何才能抓到此欄的資料呢? 註:我把全域通訊錄加入連絡人再匯出也是沒這個欄位資料. Set oEntry = oGAL.AddressEntries.Item(9000) Set oExchUser = oEntry.GetExchangeUser() Debug.Print "Name:" & oExchUser.Name Debug.Print "Alias:" & oExchUser.Alias
# by Jenwei Chen
Powershell 三行搞定,大家快來學 Powershell 吧! $OUTLOOK = New-Object -ComObject "Outlook.application" $C=$outlook.getnamespace("MAPI").AddressLists.Item("全域通訊清單").AddressEntries $C|%{$_.GetExchangeUser() |select Name,PrimarySmtpAddress,BusinessTelephoneNumber,JobTitle}
# by Jeffrey
to Jenwei, PowerShell真是Exchange的好朋友呀! 謝謝分享~
# by Jenwei Chen
To Jeffrey : 也要感謝你先吧VBA寫出來,我才能用Powershell 依樣畫葫蘆~
# by Joan
outlook 2003 無法執行此行 oExchUser As ExchangeUser 請問outlook 2003是否也能抓取全域通訊清單呢? 謝謝
# by 953904
Outlook 2003 以下只是範例: Dim oOutlookApp As Outlook.Application Dim oNamespace As Outlook.NameSpace Dim oAddressLists As AddressList Dim oAddressEntries As AddressEntries Dim oAddressEntry As AddressEntry Set oOutlookApp = New Outlook.Application Set oNamespace = oOutlookApp.GetNamespace("MAPI") Set oAddressLists = oNamespace.AddressLists(3) Set oAddressEntries = oAddressLists.AddressEntries For Each oAddressEntry In oAddressEntries ... ... Next 也可以貼到excel裡的巨集。
# by #
如果沒有Exchange,可以使用規則再加入巨集嗎? 主要用意是想在Outlook寄信前檢查規則
# by Jeffrey
to #, 不太理解你所提規則與巨集的定義及用途,可能需要再解說得更明確詳細些,大家較好幫你看問題。
# by Frank Sun
非常感謝大大的文章,但我遇到了困難,想請教您: 我公司的全域通訊錄裡面有兩個不同成員,一塊是 @abc.com 也就是我所任職的公司,另外一塊是 @xxx.abc.com,兩塊只是不同的體系,但仍屬同一公司。@abc.com 是 outlook exchange user 沒有問題,@XXX.abc.com 在通訊錄秀出來的應該是非exchange 的架構,我找不到方法可把@XXX.abc.com的成員 抓出來,想請問您是否有解決方案呢? 打擾了 & 謝謝