Solved

vb6 and Outlook Contacts

Posted on 2014-09-18
6
310 Views
Last Modified: 2014-09-19
the following code loops through all contacts in the Contacts in Outlook ...

       Dim objOutlook As Outlook.Application
       Set objOutlook = New Outlook.Application
       
       Dim objNS As Outlook.NameSpace
       Set objNS = objOutlook.Session
        
        Dim objContacts As Outlook.MAPIFolder
        Set objContacts = objNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
        Dim objItems As Object
        Set objItems = objContacts.Items
        Dim objItem As Object
        For Each objItem In objItems
'            If TypeOf(objItem) Is Outlook.ContactItem  Then
                Debug.Print objItem.FullName
'            End If
        Next

Open in new window


I need help on two things - the first being the line

'            If TypeOf(objItem) Is Outlook.ContactItem  Then

Open in new window


whilst the loop works without the line - how can I determine the type of object being looked at and make sure it is a contact item?

The second is, I want to itinerate through each item in the objItem collection ... ie the name of each item and its properties. So for example, I know that each objItem has "birthday" and "CompanyName" as a property - how can I loop through and identify each property?

MTIA

DWE
0
Comment
Question by:dwe0608
  • 3
  • 3
6 Comments
 
LVL 1

Author Comment

by:dwe0608
ID: 40331860
Hi

For the avoidance of doubt - what I am trying to do is itinerate through the properties of the Outlook Contact - a list of which can be found here

http://msdn.microsoft.com/en-us/library/microsoft.office.interop.outlook.contactitem_members(v=office.12).aspx
0
 
LVL 13

Expert Comment

by:Chris Raisin
ID: 40333390
The two lines:
        Set objContacts = objNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
       ......
       Set objItems = objContacts.Items

GUARANTEE that only contact items are being examined, since the first line collects all objects in your Contacts Folder, and the second line collects only objects that are "Items" in that collection.

The line  
                 "If TypeOf(objItem) Is Outlook.ContactItem  Then"
is therefor superfluous, since every iteration in the loop will return TRUE for that test.

The problem that you may strike is that one or more of the items may be a "Distribution List" and so does not have a  "FullName" property. For this reason you need to also test that each item is a "Distribtion List" or not
(even a distibution list is a contact item, you notice!).

And of course each distribution list can also contain other distribution lists, so you need to check that too.
When a list is encountered, each item in the distribution ist is also a contact item.

Now of course you could simply ignore distribtuion lists, since each item in the list is a "contact" in itself and will be found external to the list, and that is probably the way you should go by simply changing the code to:



Your code should therefor be simply:

  Dim objOutlook As Outlook.Application
  Set objOutlook = New Outlook.Application
       
  Dim objNS As Outlook.NameSpace
  Set objNS = objOutlook.Session
        
  Dim objContacts As Outlook.MAPIFolder
  Set objContacts = objNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
  Dim objItems As Object
  Set objItems = objContacts.Items
  Dim objItem As Object
  For Each objItem In objItems 
      If objItem.MessageClass <> "IPM.DistList" Then
        Debug.Print objItem.FullName
      endif
  next
End Sub

Open in new window

   
As an exercise run this code and you will see any distribution lists you may have
(of course if you have none, then they will not show up):

Dim objOutlook As Outlook.Application
       Set objOutlook = New Outlook.Application
       
       Dim objNS As Outlook.NameSpace
       Set objNS = objOutlook.Session
        
        Dim objContacts As Outlook.MAPIFolder
        Set objContacts = objNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
        Dim objItems As Object
        Set objItems = objContacts.Items
        Dim objItem As Object
        Dim nItem As Long
        
        For Each objItem In objItems
           nItem = nItem + 1
           If objItem.MessageClass <> "IPM.DistList" Then
             Debug.Print CStr(nItem) + ":" + objItem.FullName
           Else
             Debug.Print "-------------------------------------------"
             Debug.Print "Dist. List:" + objItem.Subject
             Debug.Print "-------------------------------------------"
             Dim x As Integer
             For x = 1 To objItem.Parent.Items.Count
               If objItem.Parent.Items(x).MessageClass <> "IPM.DistList" Then
                 nItem = nItem + 1
                 Debug.Print CStr(nItem) + ":" + objItem.Parent.Items(x).FullName
               Else
                 Debug.Print "Dist. List within this Dist. List: " + objItem.Parent.Items(x).Subject
               End If
             Next
             Debug.Print "-------------------------------------------"
           End If
        Next

Open in new window


In answer to your final question, for each item found (and I am assuming you will ignore distribution lists) you can see each property of each item using code similar to following.

It staill has a problem and I am working on it, but it may give you a clue on how to access the property names.

Stand by...

Option Explicit
Private Sub Test()
  Dim objOutlook As Outlook.Application
  Set objOutlook = New Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set objNS = objOutlook.Session
  Dim objContacts As Outlook.MAPIFolder
  Set objContacts = objNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
  Dim objItems As Object
  Set objItems = objContacts.Items
  Dim objItem As Object
  Dim oItem As ContactItem
  Dim strItemName As String
  Dim strItemValue As String
  Dim oItemValue As Variant
  Dim nClass As Integer
  Dim oType As OlItemType
  Dim nRec As Integer
  Dim nProp As Integer
  Dim nItem As Integer
  For nItem = 1 To objItems.Count
    If objItems.Item(nItem).MessageClass <> "IPM.DistList" Then
      Set oItem = objItems.Item(nItem)  'so we can look at the internals while debugguing
      For nProp = 0 To oItem.ItemProperties.Count - 1
        If oItem.ItemProperties.Item(nProp).IsUserProperty Then
          strItemName = oItem.ItemProperties.Item(nProp).Name
          strItemValue = oItem.ItemProperties.Item(nProp).Value
          Debug.Print strItemName & " = " & IIf(Len(Trim(strItemValue)) > 0, strItemValue, Chr(43) + Chr(43))
        End If
      Next nProp
    End If
  Next nItem
End Sub

Open in new window

0
 
LVL 13

Accepted Solution

by:
Chris Raisin earned 500 total points
ID: 40333568
OK...I have fixed up that last code (it changed quite a bit).

This code will list all the properties of every contact (unless the property has an empty value)
It may put you on the right track. The code basically get a collection of property items for each Outlook contact, ignoring any distribution lists.

Any property classed as  "olOutlookInternal" is skipped.

The downside to this last condition is that properties involving dates of a recurring nature will not be listed, but I think in Contacts that does not matter. This code, if adjusted to query properties of Calendar items or appointments etc., would have trouble since those items would be skipped. If you removed the line
testing for type "olOutlookInternal" then the code will crash since it cannot evaluate the value of those items with the caose as it is (it would need further work).

But here, for contacts only, it should suffice and help you out as a guide for your code changes.

Does this suffice as an answer?

Cheers

Chris (Melbourne-Australia)

Option Explicit
Private Sub ListContactProperties()
  Dim nItem As Integer
  Dim objItems As Object
  Dim colItemProps As ItemProperties
  Dim i As Integer
  Dim strItemValue As String
  Dim strItemName As String
  Dim objContacts As Outlook.MAPIFolder
  Dim objNS As Outlook.NameSpace
  Dim objOutlook As Outlook.Application
  Set objOutlook = New Outlook.Application
  
  Set objNS = objOutlook.Session

  Set objContacts = objNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
  Set objItems = objContacts.Items
  
  For nItem = 1 To objItems.Count
    If objItems.Item(nItem).MessageClass <> "IPM.DistList" Then
      Set colItemProps = objItems.Item(nItem).ItemProperties
      For i = 0 To colItemProps.Count - 1
        If colItemProps.Item(i).Type <> olOutlookInternal Then
          strItemValue = colItemProps.Item(i).Value
          If Len(Trim(strItemValue)) > 0 Then
            strItemName = colItemProps.Item(i).Name
            Debug.Print strItemName & " = " & strItemValue
          End If
        End If
      Next
    End If
  Next nItem
End Sub

Open in new window

0
Zoho SalesIQ

Hassle-free live chat software re-imagined for business growth. 2 users, always free.

 
LVL 1

Author Closing Comment

by:dwe0608
ID: 40333662
Thanks for all the input Chris ... works like a treat ... great explanation and great code! Keep an eye open for a few more questions coming along on vb6 and MSOutlook that I might post ... :-)
0
 
LVL 1

Author Comment

by:dwe0608
ID: 40333709
Chris,

I have modded the function to take a contact item as a parameter and debug.print the entire list of properties as follows:

Private Function ListContactProperties(olItem As Outlook.ContactItem)
  Dim nItem As Integer
  Dim objItems As Object
  Dim colItemProps As ItemProperties
  Dim i As Integer
  Dim strItemValue As String
  Dim strItemName As String
  Dim objContacts As Outlook.MAPIFolder
  Dim objNS As Outlook.NameSpace
  Dim objOutlook As Outlook.Application
  Set objOutlook = New Outlook.Application
  
  Set objNS = objOutlook.Session

  Set objContacts = objNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
  Set objItems = objContacts.Items
  
'  For nItem = 1 To objItems.Count
'    If objItems.Item(nItem).MessageClass <> "IPM.DistList" Then
      'Set colItemProps = objItems.Item(nItem).ItemProperties
      Set colItemProps = olItem.ItemProperties
      For i = 0 To colItemProps.Count - 1
        If colItemProps.Item(i).Type <> olOutlookInternal Then
          strItemValue = colItemProps.Item(i).Value
          'If Len(Trim(strItemValue)) > 0 Then
            strItemName = colItemProps.Item(i).Name
            Debug.Print strItemName & " = " & strItemValue
          'End If
        End If
      Next
'    End If
'  Next nItem
End Function

Open in new window


This allows me to see the properties for a single contact and deal with the data as I need.

Many thanks for the assistance its greatly appreciated.

Regards

DWE
0
 
LVL 13

Expert Comment

by:Chris Raisin
ID: 40333945
My pleasure!(Nice work on the modification!  smilie.jpg
Cheers
Chris
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Set OWA language and time zone in Exchange for individuals, all users or per database.
Resolve DNS query failed errors for Exchange
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now