如何把Outlook的Global Address Book保存到本地文件

公司内部网络中，outlook可能并不提供让员工这样做的工具。数据库Access提供的工具有时候也会出错，Visual Basic for Application有时候是比较现实的一个工具。

从Outlook的菜单中选择Tools-->Macro-->Visual Basic Editor，拷贝下面的代码并运行就可以了。警告： 此代码运行的时候会让你指定路径和保存文件名，缺省c:\Temp\Outlook Global Address Book.txt。已经存在的同路径同名文件将被覆盖！没有警告消息！！

 Sub extractglobaladdresstofile()  
   Dim gal As Outlook.AddressList  
   Dim i, icount As Integer  
   Dim exuser As Outlook.ExchangeUser  
   Dim strFileName As String  
   Dim fileHandle As Long  
   Dim line As String  
   strFileName = InputBox("Input file name. Existed file will be overwritten. Be careful!", "Data File of Global Address", "C:\Temp\Outlook Global Address Book.txt")  
   fileHandle = FreeFile()  
   icount = InputBox("Input the number of records you want to export. 0 means all instead of nothing.", "number of records", 100)  
   Open strFileName For Output As fileHandle  
   On Error GoTo 0  
   Set gal = Application.Session.AddressLists.Item("Global Address List")  
   If Not IsNull(gal) Then  
    i = 0  
    For Each ola In gal.AddressEntries  
     If ola.AddressEntryUserType = olExchangeUserAddressEntry Then  
      line = ""  
      Set exuser = ola.GetExchangeUser  
 '     If Not (IsEmpty(exuser.Alias) Or IsNull(exuser.Alias)) Then  
       Print #fileHandle, exuser.FirstName, vbTab, exuser.LastName, vbTab, exuser.JobTitle, vbTab, exuser.CompanyName, vbTab, _  
          exuser.Department, vbTab, exuser.OfficeLocation, vbTab, exuser.StreetAddress, vbTab, _  
          exuser.City, vbTab, exuser.StateOrProvince, vbTab, exuser.PostalCode, vbTab, _  
          exuser.BusinessTelephoneNumber, vbTab, exuser.MobileTelephoneNumber, vbTab, CStr(exuser.AddressEntryUserType), vbTab, _  
          exuser.PrimarySmtpAddress, vbTab, exuser.AssistantName, vbTab, exuser.Alias  
       i = i + 1  
       If i >= icount And icount <> 0 Then  
        Exit For  
       End If  
 '     End If  
     End If  
    Next ola  
   End If  
   Close fileHandle  
   MsgBox (CStr(icount) & " of " & CStr(gal.AddressEntries.count) & " contacts saved in " & strFileName & ".")  
 End Sub