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.

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

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

This article has been dead for over six months. Start a new discussion instead.