Outlook Contacts as ADO RecordSet

Sub Outlook_Contacts()
 Dim ADOConn As ADODB.Connection
 Dim ADORS As ADODB.Recordset
 Dim strConn As String
 Set ADOConn = New ADODB.Connection
 Set ADORS = New ADODB.Recordset
 With ADOConn
  'Change the Connection String below
  ' to the correct settings
  .ConnectionString = "Provider=Microsoft.JET.OLEDB.4.0;Exchange 4.0;MAPILEVEL=Outlook Address Book\;PROFILE=Outlook;TABLETYPE=1;DATABASE=c:\temp"
  .Open
 End With
 With ADORS
  Set .ActiveConnection = ADOConn
  .CursorType = adOpenStatic
  .LockType = adLockReadOnly
  .Open "Select * from [Contacts]"
  .MoveFirst
  'Test: just loop thru the first contact
  Dim i As Long
  For i = 0 To ADORS.Fields.Count - 1
   Debug.Print ADORS(i).Name + _
   vbTab + Format(ADORS(i).Value)
  Next i
  .Close
 End With
 Set ADORS = Nothing
 ADOConn.Close
 Set ADOConn = Nothing
End Sub