2
Contributors
2
Replies
3
Views
8 Years
Discussion Span
Last Post by wvtxman
0

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

0

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 topic has been dead for over six months. Start a new discussion instead.
Have something to contribute to this discussion? Please be thoughtful, detailed and courteous, and be sure to adhere to our posting rules.