|Access the master category list in the blink of an eye, share your color categories in a network, get a reminder service, and more.|
This sample reads the fields 'Fullname' and 'EMailAddress' from the table 'Customers' of your Access database, and it creates for every found recordset a new contact in Outlook.
In the procedure 'ConnectDB' change the values for the variables 'File' (file name of your Access database), 'Fields' (list of field names to be read), and 'Table' (name of the database table). Repeat the field names in the procedure 'AddContactsFromAccess' as shown, and assign the values to the appropriate ContactItem properties.
You also need to add a reference to a 'Microsoft ActiveX Data Objects x Library' via Tools/References. If there's more than one library of that type, choose the most current one. For an Access 2007 database (*.accdb file) or higher you need version 6.0 at least.
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.accdb" Fields = "Fullname, EMailAddress" Table = "Customers" Set m_Cn = New ADODB.Connection With m_Cn 'Access 2007 or higher (*.accdb file) .Provider = "Microsoft.ACE.OLEDB.12.0" 'Access 2003 or older (*.mdb file) '.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
|ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the e-mail.|