I am trying to go from Outlook to Access on 2000 on Office Professional 2000. I have selected DAO 36 and OLE Automation along iwth 9.0 of Outlook and Access as the book shows. Here is the code I am using. It is in VBScript.
The code is working. Outlook is writing perfectly to Access as long as the Access fields are text and not currency. If I make the Access fields currency that match fields in Outlook that are currency, I am allowed to write the first record without any problems. But then after that when you attempt to save anything. Outlook crashes with a Exception error c0000005 (access violation) Function: fault at 1b04d13e. The same thing happens in Windows XP.
I hope I haven't forgot anything.
Thanks.
'**********************************************************
'Procedure: Item_Write()
'Description: If the item is new, then the AddNewDatabaseRecord procedure is called.
' If the item record is in the database, the UpdateDatabaseRecord procedure is
' called if the field values have change. (ItemChanged = True)
'**********************************************************
Function Item_Write()
Call CheckPercent
If Item.UserProperties.Find("Database Record Created"

.Value = "No" then
Call AddNewDatabaseRecord ()
Item.UserProperties.Find("Database Record Created"

= "Yes"
Else
If ItemChanged = True then
Call UpdateDatabaseRecord ()
End if
End if
End Function
'***********************************************************
'Procedure: AddNewDatabaseRecord
'Description: Adds a new record to the Purchase Database
'***********************************************************
Sub AddNewDatabaseRecord ()
DbOpenTable = 1
On Error Resume Next
Set Dbe = Item.Application.CreateObject("DAO.DBEngine.36"

If Err.Number <> 0 then
Msgbox Err.Description & " -- Some functions may not work correctly"& chr(13) & "Contact your folder administrator to make sure you have DAO 3.6 installed on this machine."
Exit Sub
end if
Set myDB = Dbe.Workspaces(0).OpenDatabase("F:\OUTLOOK Templates and Databases\Purchase.mdb"

Set Rs = MyDB.OpenRecordSet("Purchase", DbOpenTable)
Rs.AddNew
Rs("Status"

=Item.Status
Call FieldValues
Rs.Update
Rs.MoveLast
Rs.close
MyDB.close
End Sub
'***********************************************************
'Procedure: UpdateDatabaseRecord
'Description: Updates an existing record in the Purchase database.
'***********************************************************
Sub UpdateDatabaseRecord ()
DBOpenTable = 1
On Error Resume Next
Set Dbe = Item.Application.CreateObject("DAO.DBEngine.36"

If Err.Number <> 0 then
Msgbox Err.Description & " -- Some functions may not work correctly" & "Contact your folder administrator to make sure you have DAO 3.6 installed on this machine."
Exit Sub
End if
Set MyDB = Dbe.Workspaces(0).OpenDatabase("F:\OUTLOOK Templates and Databases\Purchase.mdb"

Set Rs = MyDB.OpenRecordset ("Purchase", DBOpenTable)
Rs.Index = "Document ID" 'Define current index
Rs.Seek "=", item.UserProperties.Find("Document ID"

.Value
msgbox "The database has been updated."
Rs.Edit
Rs("Status"

=Item.Status
Call FieldValues
RS.Update
Rs.MoveLast
Rs.Close
MyDB.Close
End sub
'***********************************************************
'Procedure: FieldValues
'Description: Calls the CheckValue function and passes it the name of the form field
' and the database field.
'***********************************************************
Sub FieldValues ()
On Error Resume Next
CheckValue "Document ID", "Document ID"
CheckValue "(1) Requested by", "Requester"
CheckValue "Element", "Element"
CheckValue "(14) Plan Name/Prog", "Plan"
CheckValue "(15) Account", "Account"
CheckValue "Order Number", "TEO Number"
CheckValue "Completion Date", "Completion Date"
CheckValue "Year", "Year"
CheckValue "Ship Date", "Ship Date"
CheckValue "Total Capital", "Total Capital"
CheckValue "Total Expense", "Total Expense"
CheckValue "Total Softcap", "Total Softcap"
CheckValue "Total Project", "Total Project"
CheckValue "Plan Name 1", "1Plan"
CheckValue "1 Total Capital", "1Capital"
CheckValue "1 Total Expense", "1Expense"
CheckValue "1 Total Softcap", "1Softcap"
CheckValue "Plan Name 2", "2Plan"
CheckValue "2 Total Capital", "2Capital"
CheckValue "2 Total Expense", "2Expense"
CheckValue "2 Total Softcap", "2Softcap"
CheckValue "Plan Name 3", "3Plan"
CheckValue "3 Total Capital", "3Capital"
CheckValue "3 Total Expense", "3Expense"
CheckValue "3 Total Softcap", "3Softcap"
CheckValue "TEO Completed", "TEO Completed"
CheckValue "Status - Order", "Status"
CheckValue "Total Plan 1", "Total Plan 1"
CheckValue "Total Plan 2", "Total Plan 2"
CheckValue "Total Plan 3", "Total Plan 3"
CheckValue "Transfer Needed", "Transfer"
CheckValue "Number", "Number"
End Sub
'***********************************************************
'Procedure: CheckValue
'Description: Checks the field for valid data. If valid data exists, writes
' the field value to the database.
'***********************************************************
Sub CheckValue (ByVal FormField, ByVal DbField)
If Not UserProperties.Find(FormField) is Nothing then
If UserProperties.Find(FormField).Value <> "" then
If IsDate(UserProperties.Find(FormField).Value) then
If userProperties.Find(FormField).Value <> "1/1/4501" then
Rs(DbField) = UserProperties.Find(FormField).Value
else
Rs(DbField) = Null
end if
else
Rs(DbField) = UserProperties.Find(FormField).Value
end if
end if
end if
end sub