Outlook form not posting correctly to Access

[bearsgone]

I have custom form in Outlook. part of the code behind is posted below.
Problem:

If CDbl(TotalH) is 4.683333, rst!LengthofAppt is rounded up to 5 instead of staying 4.683333

Anywhere else in the code rst! value can be anything such 0.003 or 111#$23.

It seems to be Access issue, but all fields formated the same way in the table. Can not figure out why LengthofAppt is being rounded?
Thank you for any help


Here is a part of the code:

Option Explicit
Private ins As Outlook.Inspector
Private itm As Object
Private con As Outlook.AppointmentItem
Private appAccess As Access.Application
Private fso As Scripting.FileSystemObject
Private fld As Scripting.Folder
Private strAccessPath As String
Private dbe As DAO.DBEngine
Private strDBName As String
Private strDBNameAndPath As String
Private wks As DAO.Workspace
Private dbs As DAO.Database
Private rst As DAO.Recordset
Private ups As Outlook.UserProperties
Private fil As Scripting.File
Private prp As Outlook.UserProperty
Private msg As Outlook.MailItem
Private TotalH As Variant
Private TotalM As Variant



Public Sub SaveContactToAccess()

On Error GoTo ErrorHandler

Set ins = Application.ActiveInspector
Set itm = ins.CurrentItem

If itm.Class <> olAppointment Then
MsgBox "The active Inspector is not a contact item; exiting"
GoTo ErrorHandlerExit
Else
Set con = itm

Set appAccess = CreateObject("Access.Application")
strAccessPath = appAccess.SysCmd(acSysCmdAccessDir)
strAccessPath = strAccessPath & "Outlook Data\"
Debug.Print "Access database path: " & strAccessPath

Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(strAccessPath)
Set dbe = CreateObject("DAO.DBEngine.36")
strDBName = "s:\form.mdb"
strDBNameAndPath = strDBName
Debug.Print "Database name: " & strDBNameAndPath

Set fil = fso.GetFile(strDBNameAndPath)
Set wks = dbe.Workspaces(0)
Set dbs = wks.OpenDatabase(strDBNameAndPath)

Set rst = dbs.OpenRecordset("Form")
rst.AddNew

Set ups = con.UserProperties

TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
TotalH = CSng(TotalM / 60)


rst!LengthofAppt = CDbl(TotalH)

Set prp = ups.Find("Start1")
If TypeName(prp) <> "Nothing" Then
If prp <> 0 Then
rst!Appointmentstarttime = prp------------Problem line
End If
End If

Set prp = ups.Find("End2")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> 0 Then

rst!EndTimeTop = prp.Value ---- This line takes in and stores any ---------------------------------value such as 0.324 or #$%^ in access

End If
End If