Advertisement
3_2004-2005 Microsoft Office Apps/VBA #131806

Get Outlook 2002 Contact Info

I wrote a program that gets contacts from Outlook, although it worked in Outlook 2000, it did not work in 2002. This code also works in 2002, without the Outlook Object 10.0. You can use 2000's 9.0 Object Library and it still works. This caused me so much trouble, I hope it helps someone else. Please leave comments or vote if it helps.

AI

AI 요약: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

소스 코드
original-source
Private Sub Form_Load()
  Dim olns As NameSpace
  Dim itemCount As Integer
  Dim objfolder As mapiFolder
  Dim objAllContacts As Outlook.Items
  Dim i As Variant
  Dim Contact As Outlook.ContactItem
  
 
  ReDim contArray(3, 50)
  Me.restore.Enabled = False
  Me.minimize.Enabled = True
  'Create an instance of Outlook
  Set ol = CreateObject("Outlook.Application")
  Set olns = ol.GetNamespace("MAPI")
  olns.Logon
  Set objfolder = olns.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
  Set objAllContacts = objfolder.Items
  
  itemCount = objAllContacts.Count
  
  List1.Clear
  i = 0
  
  
  For i = 1 To itemCount
    If TypeOf objAllContacts.Item(i) Is Outlook.ContactItem Then
      Set Contact = objAllContacts.Item(i)
      If Contact.CompanyName <> "" Then
        contArray(1, i) = Contact.CompanyName
        contArray(2, i) = Contact.BusinessTelephoneNumber
        contArray(3, i) = Contact.BusinessFaxNumber
        List1.AddItem Contact.CompanyName
      
      End If
      If i = UBound(contArray, 2) Then
        ReDim Preserve contArray(3, i + 50)
      End If
    End If
      'i = i + 1
    
  Next
  olns.Logoff
  
  Set olns = Nothing
  
  Set objfolder = Nothing
  Set objAllContacts = Nothing
  Set Contact = Nothing
  

End Sub
원본 댓글 (3)
Wayback Machine에서 복구됨