Import to Access errors out

Status
Not open for further replies.
B

bear

Hello,

I have this code that imports a custom form into Access.

Can not figure out why it errors out on Set prp = TotalM line.

Thanks for any help

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

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

Set prp = ups.Find("TransportDate2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!TransportDate = prp.Value

End If

End If

Set prp = ups.Find("Start1")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!Appointmentstarttime = prp.Value

End If

End If

Dim TotalM As Variant

TotalM = Format((DateDiff("n", ups.Find("Start1"), ups.Find("End2")) / 60), "#,##0.00")

ERROR ---- Set prp = TotalM

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!LengthofAppt = prp.Value

End If

End If.
 
S

Sue Mosher [MVP]

That statement tries to set a UserProperty object variable to a string.

Can't be done, which is why you get an error. Your other Set prp statements

show the correct approach.

Sue Mosher

"bear" <swin_1234[at]yahoo[dot]com> wrote in message

news:%2332zOWpgKHA.1112@TK2MSFTNGP04.phx.gbl...
> Hello,

> I have this code that imports a custom form into Access.

> Can not figure out why it errors out on Set prp = TotalM line.

> Thanks for any help

> 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

> 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
> Set prp = ups.Find("TransportDate2")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!TransportDate = prp.Value
> End If
> End If
> Set prp = ups.Find("Start1")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!Appointmentstarttime = prp.Value
> End If
> End If
> Dim TotalM As Variant
> TotalM = Format((DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> / 60), "#,##0.00")

> ERROR ---- Set prp = TotalM
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!LengthofAppt = prp.Value
> End If
> End If.
 
B

bear

Thank you for response. How would I assign TotalM string to prp?

suemvp wrote on Mon, 21 December 2009 21:24
> That statement tries to set a UserProperty object variable to a string.
> Can't be done, which is why you get an error. Your other Set prp statements
> show the correct approach.
> > Sue Mosher
> > >

> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> news:%2332zOWpgKHA.1112@TK2MSFTNGP04.phx.gbl...
> > Hello,
> > I have this code that imports a custom form into Access.
> > Can not figure out why it errors out on Set prp = TotalM line.
> > Thanks for any help
> > 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
> > 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
> > Set prp = ups.Find("TransportDate2")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!TransportDate = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("Start1")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!Appointmentstarttime = prp.Value
> > End If
> > End If
> > Dim TotalM As Variant
> > TotalM = Format((DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> > / 60), "#,##0.00")
> > ERROR ---- Set prp = TotalM
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!LengthofAppt = prp.Value
> > End If
> > End If.
 
S

Sue Mosher [MVP]

The same way you would assign a value to any other object string property:

prp.Value = TotalM

Sue Mosher

"bear" <swin_1234[at]yahoo[dot]com> wrote in message

news:%23f0p1bygKHA.5460@TK2MSFTNGP06.phx.gbl...
> Thank you for response. How would I assign TotalM string to prp?

> suemvp wrote on Mon, 21 December 2009 21:24
> > That statement tries to set a UserProperty object variable to a string.
> > Can't be done, which is why you get an error. Your other Set prp
> > statements show the correct approach.
>

>> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> > news:%2332zOWpgKHA.1112@TK2MSFTNGP04.phx.gbl...
> > > Hello,
> >> > I have this code that imports a custom form into Access.
> >> > Can not figure out why it errors out on Set prp = TotalM line.
> >> > Thanks for any help
> >> > 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
> >>> > 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
> > > Set prp = ups.Find("TransportDate2")
> > > If TypeName(prp) <> "Nothing" Then
> > > If prp.Value <> 0 Then
> > > rst!TransportDate = prp.Value
> > > End If
> > > End If
> > > Set prp = ups.Find("Start1")
> > > If TypeName(prp) <> "Nothing" Then
> > > If prp.Value <> 0 Then
> > > rst!Appointmentstarttime = prp.Value
> > > End If
> > > End If
> > > Dim TotalM As Variant
> > > TotalM = Format((DateDiff("n", ups.Find("Start1"),
> > > ups.Find("End2")) / 60), "#,##0.00")
> >> > ERROR ---- Set prp = TotalM
> > > If TypeName(prp) <> "Nothing" Then
> > > If prp.Value <> 0 Then
> > > rst!LengthofAppt = prp.Value
> > > End If
> > > End If.


>
 
B

bear

That work, thank you.

As I am trying to convert minutes into hours. It errors after prp.Value = TotalH, not sure why:

Dim TotalH As Variant

Dim TotalM As Variant

TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))

TotalH = Format((TotalM / 60), "#,##0.00")

prp.Value = TotalH

Error-- If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!LengthofAppt = prp.Value

End If

End If

suemvp wrote on Tue, 22 December 2009 20:24
> The same way you would assign a value to any other object string property:

> prp.Value = TotalM
> > Sue Mosher
> > >

> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> news:%23f0p1bygKHA.5460@TK2MSFTNGP06.phx.gbl...
> > Thank you for response. How would I assign TotalM string to prp?
> > suemvp wrote on Mon, 21 December 2009 21:24
> >> That statement tries to set a UserProperty object variable to a string.
> >> Can't be done, which is why you get an error. Your other Set prp
> >> statements show the correct approach.
> >
> >> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> >> news:%2332zOWpgKHA.1112@TK2MSFTNGP04.phx.gbl...
> >> > Hello,
> >> >> > I have this code that imports a custom form into Access.
> >> >> > Can not figure out why it errors out on Set prp = TotalM line.
> >> >> > Thanks for any help
> >> >> > 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
> >> >> >> > 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
> >> > Set prp = ups.Find("TransportDate2")
> >> > If TypeName(prp) <> "Nothing" Then
> >> > If prp.Value <> 0 Then
> >> > rst!TransportDate = prp.Value
> >> > End If
> >> > End If
> >> > Set prp = ups.Find("Start1")
> >> > If TypeName(prp) <> "Nothing" Then
> >> > If prp.Value <> 0 Then
> >> > rst!Appointmentstarttime = prp.Value
> >> > End If
> >> > End If
> >> > Dim TotalM As Variant
> >> > TotalM = Format((DateDiff("n", ups.Find("Start1"),
> >> > ups.Find("End2")) / 60), "#,##0.00")
> >> >> > ERROR ---- Set prp = TotalM
> >> > If TypeName(prp) <> "Nothing" Then
> >> > If prp.Value <> 0 Then
> >> > rst!LengthofAppt = prp.Value
> >> > End If
> >> > End If.

> >
 
S

Sue Mosher [MVP]

What is the error? In any case, your logic seems to be backwards. It would

more sense to check whether a property exists *before* you try to set its

value. And the preferred way to check for the existence of an object looks

like this:

On Error Resume Next

If Not prp Is Nothing Then

prp.Value = TotalH

End If

Your code also seems confused about whether prp is a numeric or string

property.

Sue Mosher

"bear" <swin_1234[at]yahoo[dot]com> wrote in message

news:%235PcXQAhKHA.6096@TK2MSFTNGP02.phx.gbl...
> That work, thank you.
> As I am trying to convert minutes into hours. It errors after prp.Value =
> TotalH, not sure why:

> Dim TotalH As Variant
> Dim TotalM As Variant
> TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> TotalH = Format((TotalM / 60), "#,##0.00")
> prp.Value = TotalH
> Error-- If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!LengthofAppt = prp.Value
> End If
> End If
 
B

bear

Thank you for your help, I am somewhat confused about numeric and string operations.

I can not figure out why in prp.Value = TotalH, if TotalH is 0.02, prp.Value is being #12/24/2009 9:49:00 AM#.

For rst!Appointmentstarttime = prp.Value, rst!Appointmentstarttime is 0 while prp.Value is being #12/24/2009 9:49:00 AM#.

I have:

Dim TotalH As Variant

Dim TotalM As Variant

TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))

TotalH = Format((TotalM / 60), "#,##0.00")

On Error Resume Next

If Not prp Is Nothing Then

prp.Value(value shows #12/24/2009 9:49:00 AM#) =

TotalH(value shows 0.02)

End If

rst!LengthofAppt(value shows 0) =

prp.Value(value shows #12/24/2009 9:49:00 AM#)

Set prp = ups.Find("Start1")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!Appointmentstarttime(value shows 0) = prp.Value(valueshows #12/24/2009 9:49:00 AM#)

End If

End If

Thank you for your help

suemvp wrote on Wed, 23 December 2009 22:43
> What is the error? In any case, your logic seems to be backwards. It would
> more sense to check whether a property exists *before* you try to set its
> value. And the preferred way to check for the existence of an object looks
> like this:

> On Error Resume Next
> If Not prp Is Nothing Then
> prp.Value = TotalH
> End If

> Your code also seems confused about whether prp is a numeric or string
> property.
> > Sue Mosher
> > >

> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> news:%235PcXQAhKHA.6096@TK2MSFTNGP02.phx.gbl...
> > That work, thank you.
> > As I am trying to convert minutes into hours. It errors after prp.Value =
> > TotalH, not sure why:
> > Dim TotalH As Variant
> > Dim TotalM As Variant
> > TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> > TotalH = Format((TotalM / 60), "#,##0.00")
> > prp.Value = TotalH
> > Error-- If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!LengthofAppt = prp.Value
> > End If
> > End If
 
S

Sue Mosher [MVP]

It would be very helpful to know the data type for the property in

question -- string, numeric, integer, date, etc. Your latest comment

suggests it's a date/time field, in which case your TotalH value is

inappropriate, because it is not a date/time value.

Sue Mosher

"bear" <swin_1234[at]yahoo[dot]com> wrote in message

news:uc2gHPMhKHA.1460@TK2MSFTNGP06.phx.gbl...
> Thank you for your help, I am somewhat confused about numeric and string
> operations.

> I can not figure out why in prp.Value = TotalH, if TotalH is 0.02,
> prp.Value is being #12/24/2009 9:49:00 AM#.
> For rst!Appointmentstarttime = prp.Value, rst!Appointmentstarttime is 0
> while prp.Value is being #12/24/2009 9:49:00 AM#.
> I have:

> Dim TotalH As Variant
> Dim TotalM As Variant
> TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> TotalH = Format((TotalM / 60), "#,##0.00")
> On Error Resume Next
> If Not prp Is Nothing Then
> prp.Value(value shows #12/24/2009 9:49:00 AM#) = TotalH(value shows
> 0.02)
> End If
> rst!LengthofAppt(value shows 0) = prp.Value(value shows #12/24/2009
> 9:49:00 AM#) Set prp = ups.Find("Start1")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!Appointmentstarttime(value shows 0) = prp.Value(valueshows
> #12/24/2009 9:49:00 AM#)
> End If
> End If




> suemvp wrote on Wed, 23 December 2009 22:43
> > What is the error? In any case, your logic seems to be backwards. It
> > would more sense to check whether a property exists *before* you try to
> > set its value. And the preferred way to check for the existence of an
> > object looks like this:
>

>> On Error Resume Next
> > If Not prp Is Nothing Then
> > prp.Value = TotalH
> > End If
>

>> Your code also seems confused about whether prp is a numeric or string
> > property.
> > > > Sue Mosher
> > >> >> >
>
>> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> > news:%235PcXQAhKHA.6096@TK2MSFTNGP02.phx.gbl...
> > > That work, thank you.
> > > As I am trying to convert minutes into hours. It errors after prp.Value
> > > = TotalH, not sure why:
> >>> > Dim TotalH As Variant
> > > Dim TotalM As Variant
> > > TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> > > TotalH = Format((TotalM / 60), "#,##0.00")
> > > prp.Value = TotalH
> > > Error-- If TypeName(prp) <> "Nothing" Then
> > > If prp.Value <> 0 Then
> > > rst!LengthofAppt = prp.Value
> > > End If
> > > End If


>
 
B

bear

I must be not declaring prp correctly. The prp is not set and I am not sure how to set it to TotalH.

Here is what I have so far: It does not like line Set prp = TotalH.UserProperty. Skips to Error handler.

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

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

Dim TotalH As Variant

Dim TotalM As Variant

TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))

TotalH = Format((TotalM / 60), "#,##0.00")

Set prp = TotalH.UserProperty

On Error Resume Next

If Not prp Is Nothing Then

prp.Value = TotalH

End If

rst!LengthofAppt = prp.Value

Set prp = ups.Find("Start1")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!Appointmentstarttime = prp.Value

End If

End If

More Code .........

suemvp wrote on Mon, 28 December 2009 01:36
> It would be very helpful to know the data type for the property in
> question -- string, numeric, integer, date, etc. Your latest comment
> suggests it's a date/time field, in which case your TotalH value is
> inappropriate, because it is not a date/time value.
> > Sue Mosher
> > >

> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> news:uc2gHPMhKHA.1460@TK2MSFTNGP06.phx.gbl...
> > Thank you for your help, I am somewhat confused about numeric and string
> > operations.
> > I can not figure out why in prp.Value = TotalH, if TotalH is 0.02,
> > prp.Value is being #12/24/2009 9:49:00 AM#.
> > For rst!Appointmentstarttime = prp.Value, rst!Appointmentstarttime is 0
> > while prp.Value is being #12/24/2009 9:49:00 AM#.
> > I have:
> > Dim TotalH As Variant
> > Dim TotalM As Variant
> > TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> > TotalH = Format((TotalM / 60), "#,##0.00")
> > On Error Resume Next
> > If Not prp Is Nothing Then
> > prp.Value(value shows #12/24/2009 9:49:00 AM#) = TotalH(value shows
> > 0.02)
> > End If
> > rst!LengthofAppt(value shows 0) = prp.Value(value shows #12/24/2009
> > 9:49:00 AM#) Set prp = ups.Find("Start1")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!Appointmentstarttime(value shows 0) = prp.Value(valueshows
> > #12/24/2009 9:49:00 AM#)
> > End If
> > End If

>
> > suemvp wrote on Wed, 23 December 2009 22:43
> >> What is the error? In any case, your logic seems to be backwards. It
> >> would more sense to check whether a property exists *before* you try to
> >> set its value. And the preferred way to check for the existence of an
> >> object looks like this:
> >
> >> On Error Resume Next
> >> If Not prp Is Nothing Then
> >> prp.Value = TotalH
> >> End If
> >
> >> Your code also seems confused about whether prp is a numeric or string
> >> property.
> >> > >> Sue Mosher
> >> > >> > >> > >
> >
> >> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> >> news:%235PcXQAhKHA.6096@TK2MSFTNGP02.phx.gbl...
> >> > That work, thank you.
> >> > As I am trying to convert minutes into hours. It errors after prp.Value
> >> > = TotalH, not sure why:
> >> >> >> > Dim TotalH As Variant
> >> > Dim TotalM As Variant
> >> > TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> >> > TotalH = Format((TotalM / 60), "#,##0.00")
> >> > prp.Value = TotalH
> >> > Error-- If TypeName(prp) <> "Nothing" Then
> >> > If prp.Value <> 0 Then
> >> > rst!LengthofAppt = prp.Value
> >> > End If
> >> > End If

> >
 
K

Ken Slovak - [MVP - Outlook]

Set prp = TotalH.UserProperty

TotalH is a variant that's containing a date value. It has no UserProperty

property. If prp is supposed to be a user property of con then you need to

set it that way, if it's supposed to be part of ups then it needs to be set

that way. From the code I'm not sure what you're intending.

The Set prp = ups.Find("Start1") line is more in line with what I'd expect.

You can then set prp = TotalH.

"bear" <swin_1234[at]yahoo[dot]com> wrote in message

news:ugOhbG$hKHA.5520@TK2MSFTNGP06.phx.gbl...
> I must be not declaring prp correctly. The prp is not set and I am not sure
> how to set it to TotalH.
> Here is what I have so far: It does not like line Set prp =
> TotalH.UserProperty. Skips to Error handler.

> 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

> 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
> Dim TotalH As Variant
> Dim TotalM As Variant
> TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> TotalH = Format((TotalM / 60), "#,##0.00")
> Set prp = TotalH.UserProperty
> On Error Resume Next
> If Not prp Is Nothing Then
> prp.Value = TotalH
> End If
> rst!LengthofAppt = prp.Value
> Set prp = ups.Find("Start1")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!Appointmentstarttime = prp.Value
> End If
> End If

> More Code .........
 
B

bear

Hello Ken,

I am trying to assign the difference in hours and minutes between start date and end date to prp(Start1 and End2) and import that time value into access database in a form hh:mm. I think it should be part of con

Here is complete 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 = Format((TotalM / 60), "#,##0.00")

Set prp = TotalH

On Error Resume Next

If Not prp Is Nothing Then

prp.Value = TotalH

End If

rst!LengthofAppt = prp.Value

Set prp = ups.Find("Start1")

If TypeName(prp) <> "Nothing" Then

If prp <> 0 Then

rst!Appointmentstarttime = prp

End If

End If

Set prp = ups.Find("End2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!EndTimeTop = prp.Value

End If

End If

Set prp = ups.Find("TransportDate2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!TransportDate = prp.Value

End If

End If

Set prp = ups.Find("droplocation")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!LocationTop = prp.Value

End If

End If

Set prp = ups.Find("DestinationandAddr")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DestinationandAddr = prp.Value

End If

End If

Set prp = ups.Find("drop9")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!StatusTop = prp.Value

End If

End If

Set prp = ups.Find("drop8")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DepartmentTop = prp.Value

End If

End If

Set prp = ups.Find("drop3")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!ApptMadeBy = prp.Value

End If

End If

Set prp = ups.Find("TransportDate3")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DateScheduled = prp.Value

End If

End If

Set prp = ups.Find("PatientName")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!PatientName = prp.Value

End If

End If

Set prp = ups.Find("HRNTop")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!HRNTop = prp.Value

End If

End If

Set prp = ups.Find("Minor")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!Minor = prp.Value

End If

End If

Set prp = ups.Find("ParentGuardian")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!ParentGuardian = prp.Value

End If

End If

Set prp = ups.Find("NumberOfRiders")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!NumberOfRiders = prp.Value

End If

End If

Set prp = ups.Find("PatientPhone")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!PatientPhone = prp.Value

End If

End If

Set prp = ups.Find("AltPhone")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!AltPhone = prp.Value

End If

End If

Set prp = ups.Find("PatientAddress")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!PatientAddress = prp.Value

End If

End If

Set prp = ups.Find("drop5")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!GrindstoneAddress = prp.Value

End If

End If

Set prp = ups.Find("drop7")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!Insurance = prp.Value

End If

End If

Set prp = ups.Find("drop6")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DriverName = prp.Value

End If

End If

Set prp = ups.Find("drop4")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!Vehicle = prp.Value

End If

End If

Set prp = ups.Find("Start2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DepartureTime = prp.Value

End If

End If

Set prp = ups.Find("End3")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!EndingTime = prp.Value

End If

End If

Set prp = ups.Find("TotalTm")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!TotalTime = prp.Value

End If

End If

Set prp = ups.Find("MileageStarting")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!MileageStarting = prp.Value

End If

End If

Set prp = ups.Find("MileageEnding")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!MileageEnding = prp.Value

End If

End If

Set prp = ups.Find("TotalMileage")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!TotalMileage = prp.Value

End If

End If

Set prp = ups.Find("CompletedStatus2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!CompletedStatus = prp.Value

End If

End If

Set prp = ups.Find("DriverComments")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DriverComments = prp.Value

End If

End If

rst.Update

rst.Close

dbs.Close

Set wks = Nothing

Set dbe = Nothing

Set appAccess = Nothing

MsgBox con.FirstName & " " & con.LastName & "'s data exported to tblContacts"

End If

ErrorHandlerExit:

Exit Sub

kenslovak wrote on Mon, 28 December 2009 14:37
> Set prp = TotalH.UserProperty

> TotalH is a variant that's containing a date value. It has no UserProperty
> property. If prp is supposed to be a user property of con then you need to
> set it that way, if it's supposed to be part of ups then it needs to be set
> that way. From the code I'm not sure what you're intending.

> The Set prp = ups.Find("Start1") line is more in line with what I'd expect.
> You can then set prp = TotalH.

> >

>

> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> news:ugOhbG$hKHA.5520@TK2MSFTNGP06.phx.gbl...
> >I must be not declaring prp correctly. The prp is not set and I am not sure
> >how to set it to TotalH.
> > Here is what I have so far: It does not like line Set prp =
> > TotalH.UserProperty. Skips to Error handler.
> > 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
> > 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
> > Dim TotalH As Variant
> > Dim TotalM As Variant
> > TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> > TotalH = Format((TotalM / 60), "#,##0.00")
> > Set prp = TotalH.UserProperty
> > On Error Resume Next
> > If Not prp Is Nothing Then
> > prp.Value = TotalH
> > End If
> > rst!LengthofAppt = prp.Value
> > Set prp = ups.Find("Start1")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!Appointmentstarttime = prp.Value
> > End If
> > End If
> > More Code .........
 
K

Ken Slovak - [MVP - Outlook]

Whatever object the prp variable is a UserProperty of is up to you. I was

answering why you were getting an error in assigning the prp variable. You

assign a UserProperty variable in this way:

Set prp = myItem.UserProperties.Find("MyUserPropertyName")

You then set the value of that UserProperty:

prp.Value = hTime ' or whatever

The logic of the code is up to you.

"bear" <swin_1234[at]yahoo[dot]com> wrote in message

news:uvvTc7$hKHA.1540@TK2MSFTNGP06.phx.gbl...
> Hello Ken,

> I am trying to assign the difference in hours and minutes between start
> date and end date to prp(Start1 and End2) and import that time value into
> access database in a form hh:mm. I think it should be part of con

> Here is complete 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 = Format((TotalM / 60), "#,##0.00")
> Set prp = TotalH
> On Error Resume Next
> If Not prp Is Nothing Then
> prp.Value = TotalH
> End If
> rst!LengthofAppt = prp.Value
> Set prp = ups.Find("Start1")
> If TypeName(prp) <> "Nothing" Then
> If prp <> 0 Then
> rst!Appointmentstarttime = prp
> End If
> End If
> Set prp = ups.Find("End2")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!EndTimeTop = prp.Value
> End If
> End If
> Set prp = ups.Find("TransportDate2")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!TransportDate = prp.Value
> End If
> End If
> Set prp = ups.Find("droplocation")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!LocationTop = prp.Value
> End If
> End If
> Set prp = ups.Find("DestinationandAddr")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!DestinationandAddr = prp.Value
> End If
> End If
> Set prp = ups.Find("drop9")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!StatusTop = prp.Value
> End If
> End If
> Set prp = ups.Find("drop8")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!DepartmentTop = prp.Value
> End If
> End If
> Set prp = ups.Find("drop3")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!ApptMadeBy = prp.Value
> End If
> End If
> Set prp = ups.Find("TransportDate3")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!DateScheduled = prp.Value
> End If
> End If
> Set prp = ups.Find("PatientName")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!PatientName = prp.Value
> End If
> End If
> Set prp = ups.Find("HRNTop")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!HRNTop = prp.Value
> End If
> End If
> Set prp = ups.Find("Minor")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!Minor = prp.Value
> End If
> End If
> Set prp = ups.Find("ParentGuardian")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!ParentGuardian = prp.Value
> End If
> End If
> Set prp = ups.Find("NumberOfRiders")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!NumberOfRiders = prp.Value
> End If
> End If
> Set prp = ups.Find("PatientPhone")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!PatientPhone = prp.Value
> End If
> End If
> Set prp = ups.Find("AltPhone")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!AltPhone = prp.Value
> End If
> End If
> Set prp = ups.Find("PatientAddress")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!PatientAddress = prp.Value
> End If
> End If
> Set prp = ups.Find("drop5")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!GrindstoneAddress = prp.Value
> End If
> End If
> Set prp = ups.Find("drop7")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!Insurance = prp.Value
> End If
> End If
> Set prp = ups.Find("drop6")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!DriverName = prp.Value
> End If
> End If
> Set prp = ups.Find("drop4")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!Vehicle = prp.Value
> End If
> End If
> Set prp = ups.Find("Start2")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!DepartureTime = prp.Value
> End If
> End If
> Set prp = ups.Find("End3")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!EndingTime = prp.Value
> End If
> End If
> Set prp = ups.Find("TotalTm")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!TotalTime = prp.Value
> End If
> End If
> Set prp = ups.Find("MileageStarting")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!MileageStarting = prp.Value
> End If
> End If
> Set prp = ups.Find("MileageEnding")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!MileageEnding = prp.Value
> End If
> End If
> Set prp = ups.Find("TotalMileage")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!TotalMileage = prp.Value
> End If
> End If
> Set prp = ups.Find("CompletedStatus2")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!CompletedStatus = prp.Value
> End If
> End If
> Set prp = ups.Find("DriverComments")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!DriverComments = prp.Value
> End If
> End If
> rst.Update
> rst.Close
> dbs.Close
> Set wks = Nothing
> Set dbe = Nothing
> Set appAccess = Nothing
> MsgBox con.FirstName & " " & con.LastName & "'s data exported to
> tblContacts"
> End If
> ErrorHandlerExit:
> Exit Sub

>
 
B

bear

Thanks Ken.

Line Set prp = myItem.UserProperties.Find("MyUserPropertyName")would assume I want an item on my form. TotalH is not on a form and I can not get to it using Find, right? I guess I do not understand how to grab value of TotalH since it is not one of the fields on the form.

Thank you

kenslovak wrote on Mon, 28 December 2009 17:35
> Whatever object the prp variable is a UserProperty of is up to you. I was
> answering why you were getting an error in assigning the prp variable. You
> assign a UserProperty variable in this way:

> Set prp = myItem.UserProperties.Find("MyUserPropertyName")

> You then set the value of that UserProperty:

> prp.Value = hTime ' or whatever

> The logic of the code is up to you.

> >

>

> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> news:uvvTc7$hKHA.1540@TK2MSFTNGP06.phx.gbl...
> > Hello Ken,
> > I am trying to assign the difference in hours and minutes between start
> > date and end date to prp(Start1 and End2) and import that time value into
> > access database in a form hh:mm. I think it should be part of con
> > Here is complete 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 = Format((TotalM / 60), "#,##0.00")
> > Set prp = TotalH
> > On Error Resume Next
> > If Not prp Is Nothing Then
> > prp.Value = TotalH
> > End If
> > rst!LengthofAppt = prp.Value
> > Set prp = ups.Find("Start1")
> > If TypeName(prp) <> "Nothing" Then
> > If prp <> 0 Then
> > rst!Appointmentstarttime = prp
> > End If
> > End If
> > Set prp = ups.Find("End2")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!EndTimeTop = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("TransportDate2")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!TransportDate = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("droplocation")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!LocationTop = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("DestinationandAddr")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!DestinationandAddr = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("drop9")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!StatusTop = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("drop8")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!DepartmentTop = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("drop3")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!ApptMadeBy = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("TransportDate3")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!DateScheduled = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("PatientName")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!PatientName = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("HRNTop")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!HRNTop = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("Minor")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!Minor = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("ParentGuardian")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!ParentGuardian = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("NumberOfRiders")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!NumberOfRiders = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("PatientPhone")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!PatientPhone = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("AltPhone")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!AltPhone = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("PatientAddress")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!PatientAddress = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("drop5")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!GrindstoneAddress = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("drop7")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!Insurance = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("drop6")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!DriverName = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("drop4")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!Vehicle = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("Start2")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!DepartureTime = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("End3")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!EndingTime = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("TotalTm")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!TotalTime = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("MileageStarting")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!MileageStarting = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("MileageEnding")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!MileageEnding = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("TotalMileage")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!TotalMileage = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("CompletedStatus2")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!CompletedStatus = prp.Value
> > End If
> > End If
> > Set prp = ups.Find("DriverComments")
> > If TypeName(prp) <> "Nothing" Then
> > If prp.Value <> 0 Then
> > rst!DriverComments = prp.Value
> > End If
> > End If
> > rst.Update
> > rst.Close
> > dbs.Close
> > Set wks = Nothing
> > Set dbe = Nothing
> > Set appAccess = Nothing
> > MsgBox con.FirstName & " " & con.LastName & "'s data exported to
> > tblContacts"
> > End If
> > ErrorHandlerExit:
> > Exit Sub
> >
 
K

Ken Slovak - [MVP - Outlook]

A UserProperty may be bound to a form control, but it's not required and a

UserProperty can exist on an item without a custom form being involved at

all. All I was showing you is how to get the UserProperty and how to set it

to your date/time value or a calculated value.

I thought your TotalH was a calculation of some sort, if you don't know what

it is and how to get it no one else would.

"bear" <swin_1234[at]yahoo[dot]com> wrote in message

news:u5gsTkKiKHA.1824@TK2MSFTNGP04.phx.gbl...
> Thanks Ken. Line Set prp =
> myItem.UserProperties.Find("MyUserPropertyName")would assume I want an
> item on my form. TotalH is not on a form and I can not get to it using
> Find, right? I guess I do not understand how to grab value of TotalH since
> it is not one of the fields on the form. Thank you
>
 
B

bear

In this example:

Set rst = dbs.OpenRecordset("Form")

rst.AddNew

Set ups = con.UserProperties

TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))

TotalH = Format((TotalM / 60), "#,##0.00")

rst!LengthofAppt = TotalH

If TotalH is 1.02, why does rst!LengthofAppt becomes 1, instead of 1.02?

Thank you

kenslovak wrote on Tue, 29 December 2009 15:02
> A UserProperty may be bound to a form control, but it's not required and a
> UserProperty can exist on an item without a custom form being involved at
> all. All I was showing you is how to get the UserProperty and how to set it
> to your date/time value or a calculated value.

> I thought your TotalH was a calculation of some sort, if you don't know what
> it is and how to get it no one else would.

> >

>

> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> news:u5gsTkKiKHA.1824@TK2MSFTNGP04.phx.gbl...
> > Thanks Ken. Line Set prp =
> > myItem.UserProperties.Find("MyUserPropertyName")would assume I want an
> > item on my form. TotalH is not on a form and I can not get to it using
> > Find, right? I guess I do not understand how to grab value of TotalH since
> > it is not one of the fields on the form. Thank you
> >
 
S

Sue Mosher [MVP]

Maybe because LengthofAppt is set up in the database as an Integer field? In

any case, Format() returns a string, so if LengthofAppt is a numeric field

of any kind, you should use a converter method like CDbl() or CSng() to

convert that string into a numeric value.

Sue Mosher

"bear" <swin_1234[at]yahoo[dot]com> wrote in message

news:OiR8oaniKHA.1652@TK2MSFTNGP05.phx.gbl...
> In this example:
> Set rst = dbs.OpenRecordset("Form")
> rst.AddNew
> Set ups = con.UserProperties
> TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> TotalH = Format((TotalM / 60), "#,##0.00")
> rst!LengthofAppt = TotalH

> If TotalH is 1.02, why does rst!LengthofAppt becomes 1, instead of 1.02?
>
 
B

bear

Hello Sue,

My Access table takes in Numeric value in a fixed format 0.000.

I tied both methods, or combination of, you suggested, still no luck.

For rst!LengthofAppt = CDbl(TotalH), even if CDbl(TotalH) 5.01, rst!LengthofAppt is 5.

A

Set ups = con.UserProperties

TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))

TotalH = CSng(Format((TotalM / 60), "#,##0.00"))

rst!LengthofAppt = CDbl(TotalH)

B

Set ups = con.UserProperties

TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))

TotalH = CSng(Format((TotalM / 60), "#,##0.00"))

rst!LengthofAppt = CSng(TotalH)

Comple 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(Format((TotalM / 60), "#,##0.00"))

rst!LengthofAppt = CDbl(TotalH)

Set prp = ups.Find("Start1")

If TypeName(prp) <> "Nothing" Then

If prp <> 0 Then

rst!Appointmentstarttime = prp

End If

End If

Set prp = ups.Find("End2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!EndTimeTop = prp.Value

End If

End If

Set prp = ups.Find("TransportDate2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!TransportDate = prp.Value

End If

End If

Set prp = ups.Find("droplocation")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!LocationTop = prp.Value

End If

End If

Set prp = ups.Find("DestinationandAddr")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DestinationandAddr = prp.Value

End If

End If

Set prp = ups.Find("drop9")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!StatusTop = prp.Value

End If

End If

Set prp = ups.Find("drop8")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DepartmentTop = prp.Value

End If

End If

Set prp = ups.Find("drop3")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!ApptMadeBy = prp.Value

End If

End If

Set prp = ups.Find("TransportDate3")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DateScheduled = prp.Value

End If

End If

Set prp = ups.Find("PatientName")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!PatientName = prp.Value

End If

End If

Set prp = ups.Find("HRNTop")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!HRNTop = prp.Value

End If

End If

Set prp = ups.Find("Minor")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!Minor = prp.Value

End If

End If

Set prp = ups.Find("ParentGuardian")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!ParentGuardian = prp.Value

End If

End If

Set prp = ups.Find("NumberOfRiders")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!NumberOfRiders = prp.Value

End If

End If

Set prp = ups.Find("PatientPhone")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!PatientPhone = prp.Value

End If

End If

Set prp = ups.Find("AltPhone")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!AltPhone = prp.Value

End If

End If

Set prp = ups.Find("PatientAddress")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!PatientAddress = prp.Value

End If

End If

Set prp = ups.Find("drop5")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!GrindstoneAddress = prp.Value

End If

End If

Set prp = ups.Find("drop7")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!Insurance = prp.Value

End If

End If

Set prp = ups.Find("drop6")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DriverName = prp.Value

End If

End If

Set prp = ups.Find("drop4")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!Vehicle = prp.Value

End If

End If

Set prp = ups.Find("Start2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DepartureTime = prp.Value

End If

End If

Set prp = ups.Find("End3")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!EndingTime = prp.Value

End If

End If

Set prp = ups.Find("TotalTm")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!TotalTime = prp.Value

End If

End If

Set prp = ups.Find("MileageStarting")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!MileageStarting = prp.Value

End If

End If

Set prp = ups.Find("MileageEnding")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!MileageEnding = prp.Value

End If

End If

Set prp = ups.Find("TotalMileage")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!TotalMileage = prp.Value

End If

End If

Set prp = ups.Find("CompletedStatus2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!CompletedStatus = prp.Value

End If

End If

Set prp = ups.Find("DriverComments")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DriverComments = prp.Value

End If

End If

rst.Update

rst.Close

dbs.Close

Set wks = Nothing

Set dbe = Nothing

Set appAccess = Nothing

MsgBox con.FirstName & " " & con.LastName & "'s data exported to tblContacts"

End If

ErrorHandlerExit:

Exit Sub

suemvp wrote on Fri, 01 January 2010 13:16
> Maybe because LengthofAppt is set up in the database as an Integer field? In
> any case, Format() returns a string, so if LengthofAppt is a numeric field
> of any kind, you should use a converter method like CDbl() or CSng() to
> convert that string into a numeric value.
> > Sue Mosher
> > >

> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> news:OiR8oaniKHA.1652@TK2MSFTNGP05.phx.gbl...
> > In this example:
> > Set rst = dbs.OpenRecordset("Form")
> > rst.AddNew
> > Set ups = con.UserProperties
> > TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> > TotalH = Format((TotalM / 60), "#,##0.00")
> > rst!LengthofAppt = TotalH
> > If TotalH is 1.02, why does rst!LengthofAppt becomes 1, instead of 1.02?
> >
 
S

Sue Mosher [MVP]

I don't understand why you're using Format() at all in this scenario. If you

want to round the hour value to two decimal points, just use Round().

In any case, if the database isn't accepting or reporting the correct value,

that sounds like an Access issue, not an Outlook issue. I can't help you

with that.

Sue Mosher

"bear" <swin_1234[at]yahoo[dot]com> wrote in message

news:OmamphYjKHA.2132@TK2MSFTNGP05.phx.gbl...
> Hello Sue,

> My Access table takes in Numeric value in a fixed format 0.000.
> I tied both methods, or combination of, you suggested, still no luck.
> For rst!LengthofAppt = CDbl(TotalH), even if CDbl(TotalH) 5.01,
> rst!LengthofAppt is 5.
> A

> Set ups = con.UserProperties
> TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> TotalH = CSng(Format((TotalM / 60), "#,##0.00"))
> rst!LengthofAppt = CDbl(TotalH)

> B

> Set ups = con.UserProperties
> TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> TotalH = CSng(Format((TotalM / 60), "#,##0.00"))
> rst!LengthofAppt = CSng(TotalH)

> suemvp wrote on Fri, 01 January 2010 13:16
> > Maybe because LengthofAppt is set up in the database as an Integer field?
> > In any case, Format() returns a string, so if LengthofAppt is a numeric
> > field of any kind, you should use a converter method like CDbl() or
> > CSng() to convert that string into a numeric value.
>

>> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> > news:OiR8oaniKHA.1652@TK2MSFTNGP05.phx.gbl...
> > > In this example:
> > > Set rst = dbs.OpenRecordset("Form")
> > > rst.AddNew
> > > Set ups = con.UserProperties
> > > TotalM = DateDiff("n", ups.Find("Start1"),
> > > ups.Find("End2"))
> > > TotalH = Format((TotalM / 60), "#,##0.00")
> > > rst!LengthofAppt = TotalH
> >>> > If TotalH is 1.02, why does rst!LengthofAppt becomes 1, instead of
> > > 1.02?
> > >


>
 
B

bear

Hello Sue,

I was trying to get certain format, but you right, I do not need it:

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)

If CDbl(TotalH) is 4.683333, rst!LengthofAppt is rounded up to 5.

Anywhere else in the code rst! value can be anything such 0.003 or 111#$23. I do not think it has to do with Access as fields in the table are all the same.

Anything else you might sudgest?

Thank you

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

End If

End If

Set prp = ups.Find("End2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!EndTimeTop = prp.Value

End If

End If

Set prp = ups.Find("TransportDate2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!TransportDate = prp.Value

End If

End If

Set prp = ups.Find("droplocation")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!LocationTop = prp.Value

End If

End If

Set prp = ups.Find("DestinationandAddr")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DestinationandAddr = prp.Value

End If

End If

Set prp = ups.Find("drop9")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!StatusTop = prp.Value

End If

End If

Set prp = ups.Find("drop8")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DepartmentTop = prp.Value

End If

End If

Set prp = ups.Find("drop3")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!ApptMadeBy = prp.Value

End If

End If

Set prp = ups.Find("TransportDate3")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DateScheduled = prp.Value

End If

End If

Set prp = ups.Find("PatientName")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!PatientName = prp.Value

End If

End If

Set prp = ups.Find("HRNTop")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!HRNTop = prp.Value

End If

End If

Set prp = ups.Find("Minor")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!Minor = prp.Value

End If

End If

Set prp = ups.Find("ParentGuardian")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!ParentGuardian = prp.Value

End If

End If

Set prp = ups.Find("NumberOfRiders")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!NumberOfRiders = prp.Value

End If

End If

Set prp = ups.Find("PatientPhone")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!PatientPhone = prp.Value

End If

End If

Set prp = ups.Find("AltPhone")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!AltPhone = prp.Value

End If

End If

Set prp = ups.Find("PatientAddress")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!PatientAddress = prp.Value

End If

End If

Set prp = ups.Find("drop5")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!GrindstoneAddress = prp.Value

End If

End If

Set prp = ups.Find("drop7")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!Insurance = prp.Value

End If

End If

Set prp = ups.Find("drop6")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DriverName = prp.Value

End If

End If

Set prp = ups.Find("drop4")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!Vehicle = prp.Value

End If

End If

Set prp = ups.Find("Start2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DepartureTime = prp.Value

End If

End If

Set prp = ups.Find("End3")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!EndingTime = prp.Value

End If

End If

Set prp = ups.Find("TotalTm")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!TotalTime = prp.Value

End If

End If

Set prp = ups.Find("MileageStarting")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!MileageStarting = prp.Value

End If

End If

Set prp = ups.Find("MileageEnding")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!MileageEnding = prp.Value

End If

End If

Set prp = ups.Find("TotalMileage")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!TotalMileage = prp.Value

End If

End If

Set prp = ups.Find("CompletedStatus2")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!CompletedStatus = prp.Value

End If

End If

Set prp = ups.Find("DriverComments")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!DriverComments = prp.Value

End If

End If

rst.Update

rst.Close

dbs.Close

Set wks = Nothing

Set dbe = Nothing

Set appAccess = Nothing

MsgBox con.FirstName & " " & con.LastName & "'s data exported to tblContacts"

End If

ErrorHandlerExit:

Exit Sub

suemvp wrote on Mon, 04 January 2010 21:09
> I don't understand why you're using Format() at all in this scenario. If you
> want to round the hour value to two decimal points, just use Round().

> In any case, if the database isn't accepting or reporting the correct value,
> that sounds like an Access issue, not an Outlook issue. I can't help you
> with that.
> > Sue Mosher
> > >

> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> news:OmamphYjKHA.2132@TK2MSFTNGP05.phx.gbl...
> > Hello Sue,
> > My Access table takes in Numeric value in a fixed format 0.000.
> > I tied both methods, or combination of, you suggested, still no luck.
> > For rst!LengthofAppt = CDbl(TotalH), even if CDbl(TotalH) 5.01,
> > rst!LengthofAppt is 5.
> > A
> > Set ups = con.UserProperties
> > TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> > TotalH = CSng(Format((TotalM / 60), "#,##0.00"))
> > rst!LengthofAppt = CDbl(TotalH)
> > B
> > Set ups = con.UserProperties
> > TotalM = DateDiff("n", ups.Find("Start1"), ups.Find("End2"))
> > TotalH = CSng(Format((TotalM / 60), "#,##0.00"))
> > rst!LengthofAppt = CSng(TotalH)
> > suemvp wrote on Fri, 01 January 2010 13:16
> >> Maybe because LengthofAppt is set up in the database as an Integer field?
> >> In any case, Format() returns a string, so if LengthofAppt is a numeric
> >> field of any kind, you should use a converter method like CDbl() or
> >> CSng() to convert that string into a numeric value.
> >
> >> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> >> news:OiR8oaniKHA.1652@TK2MSFTNGP05.phx.gbl...
> >> > In this example:
> >> > Set rst = dbs.OpenRecordset("Form")
> >> > rst.AddNew
> >> > Set ups = con.UserProperties
> >> > TotalM = DateDiff("n", ups.Find("Start1"),
> >> > ups.Find("End2"))
> >> > TotalH = Format((TotalM / 60), "#,##0.00")
> >> > rst!LengthofAppt = TotalH
> >> >> >> > If TotalH is 1.02, why does rst!LengthofAppt becomes 1, instead of
> >> > 1.02?
> >> >

> >
 
S

Sue Mosher [MVP]

I disagree. If you set a database field to a certain value, but read out a

different value from the same field, then the cause would seem to lie in the

database. Nothing else has touched the data. It's certainly not an Outlook

issue. I have no idea what in Access could cause this other than having the

wrong data type for the field. If you pursuse this on an Access forum, which

I would recommend, be sure to reduce the code you share down to a specific

snippet that deals just with the raw vaues, not with Outlook properties.

Mentioning Outlook will only distract the Access experts from your real

issue.

Also, there is no need to use both CSng() and CDbl() on the value that

DateDiff returns. Use whichever is more appropriate to your expected data.

Sue Mosher

"bear" <swin_1234[at]yahoo[dot]com> wrote in message

news:uvHJgB$jKHA.5020@TK2MSFTNGP02.phx.gbl...
> Hello Sue,

> I was trying to get certain format, but you right, I do not need it:

> 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)

> If CDbl(TotalH) is 4.683333, rst!LengthofAppt is rounded up to 5.
> Anywhere else in the code rst! value can be anything such 0.003 or
> 111#$23. I do not think it has to do with Access as fields in the table
> are all the same.

> suemvp wrote on Mon, 04 January 2010 21:09
> > I don't understand why you're using Format() at all in this scenario. If
> > you want to round the hour value to two decimal points, just use Round().
>

>> In any case, if the database isn't accepting or reporting the correct
> > value, that sounds like an Access issue, not an Outlook issue. I can't
> > help you with that.
>

>> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> > news:OmamphYjKHA.2132@TK2MSFTNGP05.phx.gbl...
> > > Hello Sue,
> >> > My Access table takes in Numeric value in a fixed format 0.000.
> > > I tied both methods, or combination of, you suggested, still no luck.
> > > For rst!LengthofAppt = CDbl(TotalH), even if CDbl(TotalH) 5.01,
> > > rst!LengthofAppt is 5.
> > > A
> >> > Set ups = con.UserProperties
> > > TotalM = DateDiff("n", ups.Find("Start1"),
> > > ups.Find("End2"))
> > > TotalH = CSng(Format((TotalM / 60), "#,##0.00"))
> > > rst!LengthofAppt = CDbl(TotalH)
> >> > B
> >> > Set ups = con.UserProperties
> > > TotalM = DateDiff("n", ups.Find("Start1"),
> > > ups.Find("End2"))
> > > TotalH = CSng(Format((TotalM / 60), "#,##0.00"))
> > > rst!LengthofAppt = CSng(TotalH)
> >>> > suemvp wrote on Fri, 01 January 2010 13:16
> > >> Maybe because LengthofAppt is set up in the database as an Integer
> > >> field? In any case, Format() returns a string, so if LengthofAppt is a
> > >> numeric field of any kind, you should use a converter method like
> > >> CDbl() or CSng() to convert that string into a numeric value.
> > >
>> >> "bear" <swin_1234[at]yahoo[dot]com> wrote in message
> > >> news:OiR8oaniKHA.1652@TK2MSFTNGP05.phx.gbl...
> > >> > In this example:
> > >> > Set rst = dbs.OpenRecordset("Form")
> > >> > rst.AddNew
> > >> > Set ups = con.UserProperties
> > >> > TotalM = DateDiff("n", ups.Find("Start1"),
> > >> > ups.Find("End2"))
> > >> > TotalH = Format((TotalM / 60), "#,##0.00")
> > >> > rst!LengthofAppt = TotalH
> > >>> >>> >> > If TotalH is 1.02, why does rst!LengthofAppt becomes 1, instead of
> > >> > 1.02?
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
Hudas Import Outlook Emails(Inbox) to MS Access as Attachment Using Outlook 1
K Disabling import/export button to restrict PST creation Using Outlook 3
I Outlook 365 - import/attach PST file that used POP3 Using Outlook.com accounts in Outlook 0
M Export-Import .pst file problems Using Outlook 2
N .pst archive from work will not open/import on Microsoft 365 Exchange Server Administration 0
M PST import from Outlook 2007 to 2010 - Address Book contacts all in 1 group Using Outlook 4
Christopher M Import Exchange Server Administration 1
R PST->Outlook.com (Import vs Drag-n-Drop methods Using Outlook.com accounts in Outlook 2
DoctorJellybean Import accounts\files Using Outlook 1
S Import contacts to a shared mailbox Outlook VBA and Custom Forms 2
P Import Categories from Outlook 2003 Using Outlook 8
avant-guvnor Import csv problem Using Outlook 7
T Outlook 2016 CSV Translator Import Error Using Outlook 6
Rupert Dragwater How to import contact list Using Outlook 15
C Import Outlook 2016 contacts into to: field Using Outlook 1
P Import an .ics file to a specific calendar Using Outlook 4
L Need to import multiple Outlook files to Office 365 Account Using Outlook 4
R ost file import Using Outlook 2
T Outlook Calendar 2016 import Excel Using Outlook 1
I Import Office theme .thmx Using Outlook 4
Diane Poremsky Batch Import Photos into Outlook Contacts Using Outlook 0
Diane Poremsky Can't import CSV or move Outlook items into EAS Accounts Using Outlook 0
Diane Poremsky How to Import Appointments into a Group Calendar Using Outlook 0
B Import Excel Text into Outlook Calender Using Outlook 4
M How to Import YES/NO Checkboxes? BCM (Business Contact Manager) 0
J Converted .ost to .pst: Want to Import and Reconnect with IMAP Email Account Using Outlook 2
GregS Import from Outlook.com .ost to IMAP .pst? Using Outlook 3
Q Outlook 2016\365 export specific rules to import in another system Exchange Server Administration 1
Diane Poremsky Macro to Bulk Import Contacts and vCards into Outlook Using Outlook 0
Diane Poremsky Import Images into the Active Directory Using Outlook 0
M convert/import a customized record into the default "Account" record BCM (Business Contact Manager) 0
Diane Poremsky Macro to Bulk Import vCards into Outlook Using Outlook 0
e_a_g_l_e_p_i question about saving my .pst so I can import it to my Outlook after I build a new system Using Outlook 10
V Import from Outlook 2013 ost file? Using Outlook 2
ogodt Change Default contact form and import from Excel 2010 Using Outlook 1
E Want to Import Outlook 2003 pst files to later version Using Outlook 6
A Does Outlook import Gmail Archive? Using Outlook 1
E PDF Import Using Outlook 1
B Problem with import Excel BCM (Business Contact Manager) 1
bhogesh How to import .htm saved mail to outlook Using Outlook 3
J Easy way to re-import Gmail folders/labels into Outlook? Using Outlook 9
J Opening/Archiving/Import/Export PST files Using Outlook 4
Calvyn Outlook 2003 cannot import .vcs subject Using Outlook 1
R How to Import Exchange Calendar data to Outlook.com Calendar Using Outlook.com accounts in Outlook 11
R Cannot read Chinese message after import Using Outlook 2
K Excel Import Option: Need Help Updating Existing Records BCM (Business Contact Manager) 0
A import pst Outlook VBA and Custom Forms 3
Sarge USMC Cannot import/export Outlook 13 Using Outlook 6
L Outlook 2007 Codes Export and Import Using Outlook 9
L Outlook 2007 Toolbar Export and Import Using Outlook 7

Similar threads

Top