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
__________________________________________
