• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 365
  • Last Modified:

vb6 and Outlook Contacts

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
dwe0608
Asked:
dwe0608
  • 3
  • 3
1 Solution
 
dwe0608Author Commented:
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
 
Chris Raisin(Retired Analyst/Programmer)Commented:
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
 
Chris Raisin(Retired Analyst/Programmer)Commented:
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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
dwe0608Author Commented:
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
 
dwe0608Author Commented:
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
 
Chris Raisin(Retired Analyst/Programmer)Commented:
My pleasure!(Nice work on the modification!  smilie.jpg
Cheers
Chris
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now