Oulook exporting to Access database?????

[ha1r]

What I am attempting to do is have an Outlook e-mail house a separate form page with custom fields (user-defined) that can be filled out and it would housed in a public folder. Then I would like to export the information housed in the Public Folder to an Access database. This would allow me to create the reports that I am looking for.
As I have been trying to get accustomed to the code I did manage to create a form that did this with contact information. It does actually take the information from a contact folder that I created and exports it into an access database.
I've changed the code for this form to pull from a Mail items folder and I've run into error message after error message. I must be missing something.
I have attached a copy of the code I've been using. I am using two forms in the process as well. The first form labeled practice 1 has a normal e-mail message page and also has a page labeled tracking information. The tracking information page is where the user-defined fields are located.

I have published this form to a folder labeled export 1.
Anyway, I also have attached the database which I have labeled according to the code. No big deal here.

The next thing is another form where I have the code attached to the Command button labeled export.

The theory is that when you click the button it will export all the data and everyone is happy. It actually is making it through most of the code up until the end. This is where my problem lies.

Here is the code I'm using:

'VB Script code for Export form
'Exports Outlook data to an Access table, using VB Script


Dim rst
Dim dbe
Dim wks
Dim dbs
Dim nms
Dim fld
Dim itms
Dim itm
Dim strAccessPath
Dim appAccess
Dim strFolder
Dim fFound

Sub cmdExport_Click

Set nms = Application.GetNameSpace("MAPI")
strFolder = "Export1"

'Check for existence of Contacts from Access folder
'and exit if not found
fFound = False
FindFolder nms.Folders("Mailbox - Greg Miller").Folders, 0, strFolder

If fFound = True Then
Set fld = nms.Folders("Mailbox - Greg Miller").Folders(strFolder)
ElseIf fFound = False Then
MsgBox "Export1 folder not found; exiting"
Exit Sub
End If

'Pick up path to Access database directory from Access SysCmd function
Set appAccess = Item.Application.CreateObject("Access.Application")
strAccessPath = appAccess.SysCmd(9)
'Get DAO version from DBEngine
strDBEngine = appAccess.Application.DBEngine.Version
'MsgBox "DBEngine version: " & strDBEngine
appAccess.Quit

If strDBEngine = "3.51" Then
'Office 97 DAO version
Set dbe = Item.Application.CreateObject("DAO.DBEngine.35")
strDBName = strAccessPath & "Contacts 97.mdb"
ElseIf strDBEngine = "3.6" Then
'Office 2000 DAO version
Set dbe = Item.Application.CreateObject("DAO.DBEngine.36")
strDBName = strAccessPath & "Contacts 2000.mdb"
Else
MsgBox "Unknown Office version; canceling"
Exit Sub
End If

'MsgBox "DBName: " & strDBName
strDBName = "D:\DATA\MY DOCUMENTS\inc app project\Practice1.mdb"
Set wks = dbe.Workspaces(0)
Set dbs = wks.OpenDatabase(strDBName)

'Open Access table containing contact data
Set rst = dbs.OpenRecordset("Export1")

'Set up reference to Outlook folder of items to export
Set itms = fld.Items
ItemCount = itms.Count
If ItemCount = 0 Then
MsgBox "No Things to export"
Exit Sub
Else
MsgBox ItemCount & " Things to export"
End If

rst.AddNew

'Standard Outlook properties
rst.Subject = Item.Subject
rst.To = Item.To

'Custom Outlook properties
rst.AFO Code = Item.UserProperties("AFOCode")
rst.Agent Code = Item.Userproperties("AgentCode")
rst.Update

rst.Close
MsgBox "All Items exported!"

End Sub


Function FindFolder(Parent, Depth, ShortName)

Dim Root

Root = "Personal"
For Each fld In Parent
If fld.Name = strFolder Then
fFound = True
Exit Function
End If
Next

End Function