Loop through Contacts

Peter R Hawkes · Joined: 05 Aug 2007 Posts: 1

After many tries I seem to have failed in putting the code together to loop
through all contacts. the following snippet is from Sue Moshers' excellent
book but I am lost as to how;

1. To declare objFolder and objItem
2. To set objItem

Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objContacts As Outlook.MAPIFolder
Dim objContact As Outlook.ContactItem

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderContacts)

For Each objItem In objFolder.Items
'code
Next

Before I pull all of my hair out could someone fill in the gaps!

Thanks

Peter R Hawkes

Archived from group: microsoft>public>exchange>applications

Stewart Parker · Joined: 05 Aug 2007 Posts: 1

Try pasting the following function into your app. It use
either late or early binding methods : late binding is
enabled as default although it is not as fast as the early
method. The advantage is that it won't crash if MS Outlook
isn't installed - it just lets you know and bugs out!

Public Function Get_Outlook()
' This function retrieves all contacts from the Outlook
' Contacts folder where there is a Business Address and
' places those items in the contacts table.
' This example use either early or late binding
methods (comment out as needed!)

Dim olapp As Object '(Late binding)
'Dim olapp As Outlook.Application (Early
Binding)
Dim nspNameSpace As Object 'Outlook.NameSpace
Dim fldContacts As Object 'Outlook.MAPIFolder
Dim objContacts As Object
Dim objContact As Object
Dim strZLS As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim R As Variant
Dim intProgress As Integer

Const ERR_APP_NOTFOUND As Long = 429

On Error GoTo GetAll_Err
' Initialize zero-length string variable
' used in the Restrict method argument.
strZLS = ""
' Get reference to the Outlook Contacts folder.
'Set olapp = New Outlook.Application (Early binding)
Set olapp = CreateObject("Outlook.Application") '
(Late Binding)
Set nspNameSpace = olapp.GetNamespace("MAPI")
Set fldContacts = nspNameSpace.GetDefaultFolder
(10) 'olFolderContacts = 10
Set objContacts = fldContacts.Items.Restrict
("[FullName] '" & strZLS & "'")

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Addresses", dbOpenDynaset)

For Each objContact In objContacts
' Add only entries that include a full name.
rst.FindFirst "ContactName = '" &
objContact.FullName & "'"
If rst.NoMatch Then
rst.addnew
rst!ContactName = objContact.FullName
rst!Company = objContact.CompanyName
rst!Address = objContact.BusinessAddress
rst!PostalCode =
objContact.BusinessAddressPostalCode
rst!Country = objContact.BusinessAddressCountry
rst!WorkPhone =
objContact.BusinessTelephoneNumber
rst!HomePhone = objContact.HomeTelephoneNumber
rst!MobilePhone =
objContact.MobileTelephoneNumber
rst!EmailAddress = objContact.Email1Address
If Len(objContact.webpage) > 0 Then
rst!WebAddress = "#" & objContact.webpage
& "#"
End If
rst!FaxNumber = objContact.BusinessFaxNumber
rst.Update
End If
Next objContact
rst.Close
Set dbs = Nothing

GetAll_Bye:
Exit Function

GetAll_Err:
If Err = ERR_APP_NOTFOUND Then
MsgBox "Outlook is not installed on this
machine.", _
vbInformation + vbOKOnly, _
"No OutLook"
Resume GetAll_Bye
End If
If Err.Number = 3077 Then Resume Next
MsgBox Err.Description, vbOKOnly, "Error = " &
Err.Number
Resume GetAll_Bye
If Err.Number = 3163 Then
MsgBox Err.Description, vbOKOnly, "Error = " &
Err.Number

Resume Next
End If
Resume Next
End Function

Good luck
>-----Original Message-----
>After many tries I seem to have failed in putting the
code together to loop
>through all contacts. the following snippet is from Sue
Moshers' excellent
>book but I am lost as to how;
>
>1. To declare objFolder and objItem
>2. To set objItem
>
> Dim objApp As Outlook.Application
> Dim objNS As Outlook.NameSpace
> Dim objContacts As Outlook.MAPIFolder
> Dim objContact As Outlook.ContactItem
>
> Set objApp = CreateObject("Outlook.Application")
> Set objNS = objApp.GetNamespace("MAPI")
> Set objFolder = objNS.GetDefaultFolder
(olFolderContacts)
>
> For Each objItem In objFolder.Items
> 'code
> Next
>
>Before I pull all of my hair out could someone fill in
the gaps!
>
>Thanks
>
>Peter R Hawkes
>
>
>.
>