A mi me funciona muy bien con este código + proyecto - referecias e incluir outlook versión 9.0 +-
Set RetVal = New Outlook.Application
Set NameSpace = RetVal.GetNamespace("MAPI")
'*********** para acceder a los folders y modificar contactos
For intI = NameSpace.Folders.Count To 1 Step -1
Set colFolders = NameSpace.Folders(intI)
On Error Resume Next
Set objfolder = colFolders.Folders("Contactos")
If Err.Number = 0 Then
Exit For
Else
End If
Next intI
If colFolders Is Nothing Then
MsgBox "Unable to find Outlook Contacts folder", vbCritical, "Outlook error..."
End If
Set contacto = RetVal.objfolder.Items(olContactItem)
Set contacto = objfolder.Items.GetFirst
With contacto
Proyecto1.Contact.txtLname.Text = .LastName
Proyecto1.Contact.txtFName.Text = .FirstName
Proyecto1.Contact.txtMName.Text = .MiddleName
Proyecto1.Contact.txtJobTitle = .JobTitle
Contact.txtProgramas.Text = .Categories
%0
