LISTA DE CONTATOS DO OUTLOOK

KMELEON 24/12/2003 15:41:24
#2334 Resposta escolhida

'Referencie o Activex Data Objects (ADO)
'de sua preferência
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Long

Set con = New ADODB.Connection
Set rs = New ADODB.Recordset

With con
.ConnectionString = "Provider=Microsoft.JET.OLEDB.4.0;" & _
"Exchange 4.0;" & _
"MAPILEVEL=C:\...\dados de aplicativos\Microsoft\Address book\;" & _ 'aponte para a pasta onde esta o ctalogo de endereços
"PROFILE=Outlook;" & _
"TABLETYPE=1;" & _
"DATABASE=NOMEDOCATALOGO.wab"
.Open
End With

'GoTo 10
With rs
Set .ActiveConnection = con
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Open "Select * from [Contacts]"
.MoveFirst

Do While Not rs.EOF
For i = 0 To rs.Fields.Count - 1
Debug.Print rs(i).Name + vbTab + Format(rs(i).Value)
Next i

rs.MoveNext
Loop

.Close
End With

Set rs = Nothing
con.Close
Set rs = Nothing