Results 1 to 4 of 4

Thread: VB6 - List Outlook Contacts in any Selected Folder

  1. #1

    Thread Starter
    Ex-Super Mod RobDog888's Avatar
    Join Date
    Apr 2001
    Location
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™
    Posts
    60,710

    VB6 - List Outlook Contacts in any Selected Folder

    After a few years I cant believe that there are no entries in CodeBank
    for Outlook Contacts. It was suggested I post some of my code
    that is already out on the Forums here for easy reference.

    This is one I just updated and is complete. It will list in a combo
    box the selected contact. You can also display the details of it
    also.

    The .PickFolder method is perfect for allowing the user to select
    which folder to display the contacts of instead of hard coding the
    paths. The .PickFolder method is included in Outlook XP (2002)
    and above.



    Project on next post in case you want to download it.

    VB Code:
    1. 'BEHIND A FORM
    2. 'REQUIREMENTS:
    3. 'REFERENCE TO MS OUTLOOK 10.0 OR ABOVE.
    4. '3 COMMAND BUTTONS - CMDCLOSE, CMDDISPLAY, AND CMDBROWSE.
    5. '5 LABELS - LBLCONTACTS, LBLLOCATION, LBLPATH, LBLCOUNT (2).
    6. '1 COMBOBOX - CBOCONTACT - LOADS WITH THE SELECTED FOLDERS CONTACTS
    7. Option Explicit
    8.  
    9. Private moApp As Outlook.Application
    10. Private moNS As Outlook.NameSpace
    11. Private moFolder As Outlook.MAPIFolder
    12. Private moContactItem As Outlook.ContactItem
    13. Private moDistributionList As Outlook.DistListItem
    14. Private mbClose As Boolean
    15.  
    16. Private Sub cmdClose_Click()
    17.     MousePointer = vbHourglass
    18.     Unload Me
    19. End Sub
    20.  
    21. Private Sub cmdBrowse_Click()
    22.  
    23.     Dim i As Integer
    24.    
    25.     Screen.MousePointer = vbHourglass
    26.     'SELECT A CONTACT FOLDER TO LIST (PRIVATE OR PUBLIC)
    27.     Set moFolder = moNS.PickFolder
    28.     If TypeName(moFolder) = "Nothing" Then
    29.         Screen.MousePointer = vbNormal
    30.         Me.SetFocus
    31.         Exit Sub
    32.     ElseIf moFolder.DefaultItemType <> olContactItem Then
    33.         MsgBox "'Contact' type folders only!", vbOKOnly + vbExclamation, App.ProductName
    34.         Screen.MousePointer = vbNormal
    35.         Me.SetFocus
    36.         Exit Sub
    37.     End If
    38.    
    39.     Screen.MousePointer = vbHourglass
    40.     Me.SetFocus
    41.     lblPath.Caption = moFolder.FolderPath
    42.     lblCount(1).Caption = moFolder.Items.Count
    43.     cboContact.Clear
    44.     cboEntryID.Clear
    45.     If moFolder.Items.Count > 0 Then
    46.         For i = 1 To moFolder.Items.Count
    47.             DoEvents
    48.             If moFolder.Items.Item(i).Class = 69 Then
    49.                 Set moDistributionList = moFolder.Items.Item(i)
    50.                 cboContact.AddItem moDistributionList.DLName & " (Distributiion List)"
    51.                 cboContact.ItemData(i - 1) = 0
    52.                 cboEntryID.AddItem moDistributionList.EntryID
    53.                 Set moDistributionList = Nothing
    54.             Else
    55.                 Set moContactItem = moFolder.Items.Item(i)
    56.                 cboContact.AddItem moContactItem.FullName & " (" & moContactItem.CompanyName & ")"
    57.                 cboContact.ItemData(i - 1) = 1
    58.                 cboEntryID.AddItem moContactItem.EntryID
    59.                 Set moContactItem = Nothing
    60.             End If
    61.         Next
    62.         cboContact.ListIndex = 0
    63.     Else
    64.         cmdDisplay.Enabled = False
    65.     End If
    66.     Screen.MousePointer = vbNormal
    67.    
    68. End Sub
    69.  
    70. Private Sub cmdDisplay_Click()
    71.  
    72.     Dim sContact As String
    73.    
    74.     'SYNC CONTACTS TO ENTRYIDS
    75.     cboEntryID.ListIndex = cboContact.ListIndex
    76.    
    77.     If cboContact.ListIndex <> -1 Then
    78.         sContact = Left$(cboContact.Text, InStr(1, cboContact.Text, "(") - 2)
    79.         If moFolder.Items.Item(sContact).Class = 69 Then
    80.             Set moDistributionList = moFolder.Items.Item(cboEntryID.Text)
    81.             'MAKE SURE THERE ARE NOT TWO CONTACTS WITH THE SAME NAME
    82.             If moDistributionList.EntryID = cboEntryID.Text Then
    83.                 moDistributionList.Display True
    84.             Else
    85.                 Set moDistributionList = moNS.GetItemFromID(cboEntryID.Text)
    86.                 moDistributionList.Display True
    87.             End If
    88.             Set moDistributionList = Nothing
    89.         Else
    90.             Set moContactItem = moFolder.Items.Item(sContact)
    91.             'MAKE SURE THERE ARE NOT TWO CONTACTS WITH THE SAME NAME (DIFFERENT COMPANIES)
    92.             If moContactItem.EntryID = cboEntryID.Text Then
    93.                 moContactItem.Display True
    94.             Else
    95.                 Set moContactItem = moNS.GetItemFromID(cboEntryID.Text)
    96.                 moContactItem.Display True
    97.             End If
    98.             Set moContactItem = Nothing
    99.         End If
    100.     End If
    101.    
    102. End Sub
    103.  
    104. Private Sub Form_Load()
    105.    
    106.     On Error GoTo No_Bugs
    107.    
    108.     mbClose = False
    109.     'ATTACH TO OUTLOOK IF RUNNING - IF NOT CREATE NEW
    110.     Set moApp = GetObject(, "Outlook.Application")
    111.     If TypeName(moApp) = "Nothing" Then
    112.         Set moApp = New Outlook.Application
    113.         mbClose = True
    114.     End If
    115.     'GET NAMESPACE AND OUTLOOK VERSION
    116.     Set moNS = moApp.GetNamespace("MAPI")
    117.     If InStr(1, moApp.Version, "10.") > 1 Then
    118.         MsgBox "Unsupported Outlook version!", vbOKOnly + vbExclamation, App.ProductName
    119.         Set moNS = Nothing
    120.         Set moApp = Nothing
    121.     End If
    122.     frmMain.Caption = App.ProductName
    123.     Exit Sub
    124.    
    125. No_Bugs:
    126.     If Err.Number = 429 Then
    127.         MsgBox Err.Number & " - " & Err.Description, vbOKOnly + vbExclamation, App.ProductName
    128.         Resume Next
    129.     Else
    130.         MsgBox Err.Number & " - " & Err.Description, vbOKOnly + vbExclamation, App.ProductName
    131.     End If
    132.    
    133. End Sub
    134.  
    135. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    136.     Set moContactItem = Nothing
    137.     Set moFolder = Nothing
    138.     Set moNS = Nothing
    139.     If mbClose = True And TypeName(moApp) <> "Nothing" Then
    140.         moApp.Quit
    141.     End If
    142.     Set moApp = Nothing
    143. End Sub
    Enjoy..

    VB/Outlook Guru™
    Attached Images Attached Images  
    Last edited by RobDog888; Oct 23rd, 2004 at 11:26 AM.
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019, VB6 SP6

  2. #2

    Thread Starter
    Ex-Super Mod RobDog888's Avatar
    Join Date
    Apr 2001
    Location
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™
    Posts
    60,710
    Here is the complete project.

    Attached Files Attached Files
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019, VB6 SP6

  3. #3
    New Member
    Join Date
    Jun 2006
    Posts
    2

    Re: VB6 - List Outlook Contacts in any Selected Folder

    Hallo,

    very good Project.

    question:

    Wwhat is way to get all filed names like moContactItem.FullName? Do you know a script to display the filed names?

    thanks

    Fabian

  4. #4

    Thread Starter
    Ex-Super Mod RobDog888's Avatar
    Join Date
    Apr 2001
    Location
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™
    Posts
    60,710

    Re: VB6 - List Outlook Contacts in any Selected Folder

    Thanks and Welcome to the forums.

    You can use the Object Browser to explore the rest of the fields that can be obtained by using the Outlook Object Model. If you still want even more then you can use the Collaboration Data Object (CDO) 1.21 library which will get the rest.
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019, VB6 SP6

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width