I am try to use code to export user-defined fields from outlook task to an access DBase. I have seen the Microsoft Knowledge Base Article "How to Programmatically Export Items to Microsoft Access". However this article is for contact information. Can you help me modifiy this code to export task information suchas subject, body and date completed?
Sub ImportTasksFromOutlook()
' This code is based in Microsoft Access.
' Set up DAO objects (uses existing "tasks" table)
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("tasks"![Wink ;) ;)](data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7)
' Set up Outlook objects.
Dim ol As New Outlook.Application
Dim olns As Outlook.Namespace
Dim cf As Outlook.MAPIFolder
Dim c As Outlook.ContactItem
Dim objItems As Outlook.Items
Dim Prop As Outlook.UserProperty
Set olns = ol.GetNamespace("MAPI"![Wink ;) ;)](data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7)
Set cf = olns.GetDefaultFolder(olFolderContacts)
Set objItems = cf.Items
iNumContacts = objItems.Count
If iNumContacts <> 0 Then
For i = 1 To iNumContacts
If TypeName(objItems(i)) = "ContactItem" Then
Set c = objItems(i)
rst.AddNew
rst!FirstName = c.FirstName
rst!LastName = c.LastName
rst!Address = c.BusinessAddressStreet
rst!City = c.BusinessAddressCity
rst!State = c.BusinessAddressState
rst!Zip_Code = c.BusinessAddressPostalCode
' Custom Outlook properties would look like this:
' rst!AccessFieldName = c.UserProperties("OutlookPropertyName"![Wink ;) ;)](data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7)
rst.Update
End If
Next i
rst.Close
MsgBox "Finished."
Else
MsgBox "No contacts to export."
End If
End Sub
Sub ImportTasksFromOutlook()
' This code is based in Microsoft Access.
' Set up DAO objects (uses existing "tasks" table)
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("tasks"
' Set up Outlook objects.
Dim ol As New Outlook.Application
Dim olns As Outlook.Namespace
Dim cf As Outlook.MAPIFolder
Dim c As Outlook.ContactItem
Dim objItems As Outlook.Items
Dim Prop As Outlook.UserProperty
Set olns = ol.GetNamespace("MAPI"
Set cf = olns.GetDefaultFolder(olFolderContacts)
Set objItems = cf.Items
iNumContacts = objItems.Count
If iNumContacts <> 0 Then
For i = 1 To iNumContacts
If TypeName(objItems(i)) = "ContactItem" Then
Set c = objItems(i)
rst.AddNew
rst!FirstName = c.FirstName
rst!LastName = c.LastName
rst!Address = c.BusinessAddressStreet
rst!City = c.BusinessAddressCity
rst!State = c.BusinessAddressState
rst!Zip_Code = c.BusinessAddressPostalCode
' Custom Outlook properties would look like this:
' rst!AccessFieldName = c.UserProperties("OutlookPropertyName"
rst.Update
End If
Next i
rst.Close
MsgBox "Finished."
Else
MsgBox "No contacts to export."
End If
End Sub