How to open contacts in with vb

[wvtxman]

can someone tell me how to write the code to open the contacts in outlook 2007 and be able to select contact for email.

Thank you.

[cguan_77]

ohh....i think it's not that simple..because once a user is given an access to the contacts for outlook he can easily exploit and take advantage of the user's address books.. and spread some virus or what....

what i mean i don't know if there's a way from VB to access the contacts in outlook..if you find one let me know.. LOL

[wvtxman]

Ok the following code works but if their is a group in the contact folder it stops what code would be needed to detect a group or distribution list?
Thanks in advance

Private objApp As Outlook.Application
Private objNS As Outlook.NameSpace
Private objFolder As Outlook.MAPIFolder
Private objItem As Outlook.ContactItem
Private colAdressFolders As Collection

Sub Main()

Dim lngLoop As Long
Set objApp = New Outlook.Application
Set objNS = objApp.GetNamespace("MAPI")
Set colAdressFolders = New Collection
Set objFolder = objNS.Folders.GetFirst ' get root-folder
' recursive loop thrue all folders to co
' llect the references to Adressbooks

For lngLoop = 1 To objFolder.Folders.Count

If objFolder.Folders.Item(lngLoop).DefaultItemType = olContactItem Then
RecursiveSearch objFolder.Folders.Item(lngLoop), colAdressFolders
End If
Next lngLoop

' open every contact-folder and loop all
' entries

For Each objFolder In colAdressFolders

For lngLoop = 1 To objFolder.Items.Count
Set objItem = objFolder.Items(lngLoop)

Debug.Print objItem.FullName, objItem.Email1Address

Next lngLoop
Next

End Sub

Private Sub RecursiveSearch(objSubFolder As Outlook.MAPIFolder, colAdrFolders As Collection)

On Error GoTo Errorhandler
Dim lngLoop As Long
' check for entries in this subfolder

If objSubFolder.Items.Count > 0 Then
'add reference to collection
colAdrFolders.Add objSubFolder
End If
' check for subfolders

If objSubFolder.Folders.Count > 0 Then

For lngLoop = 1 To objSubFolder.Folders.Count
RecursiveSearch objSubFolder.Folders.Item(lngLoop), colAdrFolders
Next lngLoop
End If
Exit Sub
Errorhandler:
MsgBox "An unexpected error occured methode RECURSIVESEARCH", vbCritical + vbOKOnly, "Problem"
Err.Clear
End Sub

Private Sub Form_Load()
Call Main

End Sub