Public Sub AddContactsFromAccess()
  Dim Contact As Outlook.ContactItem
  Dim Name As String
  Dim Fields As ADODB.Fields

  ConnectDB
  Set Fields = m_Rs.Fields

  While Not m_Rs.EOF
    Set Contact = Application.CreateItem(olContactItem)

    Name = "Fullname"
    If IsNull(Fields(Name).Value) = False Then
      Contact.FullName = Fields(Name).Value
    End If

    Name = "EMailAddress"
    If IsNull(Fields(Name).Value) = False Then
      Contact.FullName = Fields(Name).Value
    End If

    Contact.Save
    m_Rs.MoveNext
  Wend

  m_Rs.Clone: Set m_Rs = Nothing
  m_Cn.Close: Set m_Cn = Nothing
End Sub

Private Sub ConnectDB()
  Dim File As String
  Dim Table As String
  Dim Fields As String

  File = "c:\test.mdb"

  Fields = "Fullname, EMailAddress"
  Table = "Customers"

  Set m_Cn = New ADODB.Connection
  With m_Cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = File
    .CursorLocation = adUseClient
    .Mode = adModeShareDenyNone
    .Open
  End With

  Set m_Rs = New ADODB.Recordset
  With m_Rs
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockOptimistic
    Set .ActiveConnection = m_Cn
    .Open ("SELECT " & Fields & " FROM " & Table)
  End With
End Sub