Hi StuJol,

What kind of trouble are you having?


Tom Wickerath
Microsoft Access MVP

http://www.access.qbuilt.com/html/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________

Hi StuJol,

An easier way to get both contact and appointment information is to simply
create linked tables, using:

   File > Get External Data > Link Tables...

Pick Outlook() using the Files of Type dropdown list. No code required!  
However, on my PC, I had to initiate a Detect and Repair operation from the
Help menu, before the wizard would work without throwing an error. At this
time, I'm not too inclined to want to spend the time modifying the code to
get appointment information, since all of the information is available using
linked tables.

Regarding the code that you presented below, I have several comments:

1.) I recommend always documenting the source of your code. In this case,
adding a comment such as this to the procedure will be helpful at a later
date, if you need to revisit this code:

    How to Programmatically Export Items to Microsoft Access
    http://support.microsoft.com/kb/253794/

2.) I do not like the fourth bullet shown, which reads as follows:

    "The code below assumes that the Access fields are set to
      Allow Zero-Length Values."

See Access MVP Allen Browne's page on this topic:

     Problem properties
     http://allenbrowne.com/bug-09.html

One modification that works is to use the following. Note: I substituted a
With rst...End With construct, to avoid having to repeat "rst" several times:

With rst
   .AddNew
       If Len(c.FirstName) > 0 Then !FirstName = c.FirstName
       If Len(c.LastName) > 0 Then !LastName = c.LastName
       If Len(c.HomeAddress) > 0 Then !Address = c.BusinessAddressStreet
       If Len(c.HomeAddressCity) > 0 Then !City = c.BusinessAddressCity
       If Len(c.HomeAddressState) > 0 Then !State = c.BusinessAddressState
       If Len(c.HomeAddressPostalCode) > 0 Then _
             !Zip_Code = c.BusinessAddressPostalCode
   .Update
End With

3.) You should configure the VBE (Visual Basic Editor) on your PC so that
you will always get those two very important words as the second line of
every code module:

    Always Use Option Explicit
    http://www.access.qbuilt.com/html/gem_tips.html#VBEOptions

The author of the KB article obviously did not have his/her PC properly
configured. Otherwise, surely they would have discovered that they had not
declared two variables, "i" and "iNumContacts".

4.) The author of the KB article included "rst.Close" to close the
recordset, but failed to destroy this object variable by setting it to
nothing. One should provide a proper error handler where such objects are
destroyed, even in the event of an error. The code, as written, could error
out and still leave the rst variable in memory (ie. a memory leak). Also,
failing to properly close and destroy recordsets can cause database bloat.
Here is my suggested revision to the code shown in the KB article. Note: I
removed some indenting to prevent line wrap:

Private Sub cmdGetContacts_Click()
On Error GoTo ProcError

  ' Set up DAO objects (uses existing "tblContacts" table)
  Dim rst As DAO.Recordset
  Set rst = CurrentDb.OpenRecordset("tblContacts")

  ' Set up Outlook objects.
  Dim oOL As Outlook.Application
  Dim oNS As Outlook.NameSpace
  Dim oFolder As Outlook.MAPIFolder
  Dim c As Outlook.ContactItem
  Dim objItems As Outlook.Items
  Dim Prop As Outlook.UserProperty
  Dim i As Integer
  Dim iNumContacts As Integer

  Set oNS = Outlook.Application.GetNamespace("MAPI")
  Set oFolder = oNS.GetDefaultFolder(olFolderContacts)
  Set objItems = oFolder.Items
 
  iNumContacts = objItems.count
  Debug.Print iNumContacts
  If iNumContacts <> 0 Then
     For i = 1 To iNumContacts
        Debug.Print i, TypeName(objItems(i)), objItems(i)
       
        If TypeName(objItems(i)) = "ContactItem" Then
           Set c = objItems(i)
               With rst
                   .AddNew
       If Len(c.FirstName) > 0 Then !FirstName = c.FirstName
       If Len(c.LastName) > 0 Then !LastName = c.LastName
       If Len(c.HomeAddress) > 0 Then !Address = c.BusinessAddressStreet
       If Len(c.HomeAddressCity) > 0 Then !City = c.BusinessAddressCity
       If Len(c.HomeAddressState) > 0 Then !State = c.BusinessAddressState
       If Len(c.HomeAddressPostalCode) > 0 Then _
             !Zip_Code = c.BusinessAddressPostalCode

                   .Update
               End With

        End If
       
     Next i
     MsgBox "Finished."
  Else
     MsgBox "No contacts to export."
  End If

ExitProc:
   'Cleanup
   On Error Resume Next
   rst.Close: Set rst = Nothing
   Exit Sub
ProcError:
   MsgBox "Error " & Err.Number & ": " & Err.Description, _
         vbCritical, "Error in procedure cmdGetContacts_Click..."
   Resume ExitProc
   Resume
End Sub

Tom Wickerath
Microsoft Access MVP

http://www.access.qbuilt.com/html/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________