Form into access

Status
Not open for further replies.
B

bear

Thank you in advance for any help.

I have this code as an example that imports contact into access. Second code is an attempt to enter existing appointment from a calendar into access. Can not pass MsgBox "The active Inspector is not a contact item; exiting" error. Code A works fine for contacts.

Code A:

Option Explicit

Private ins As Outlook.Inspector

Private itm As Object

Private con As Outlook.ContactItem

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 <> olContact Then

MsgBox "The active Inspector is not a contact item; exiting"

GoTo ErrorHandlerExit

Else

Set con = itm

'Pick up path to Access database directory from Access SysCmd function

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 = "Personal 2000.mdb"

strDBNameAndPath = strAccessPath & 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("tblContacts")

rst.AddNew

If con.Title <> "" Then

rst!Title = con.Title

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

ErrorHandler:

If Err.Number = 76 Then

Set fld = fso.CreateFolder(strAccessPath)

MsgBox strAccessPath & _

" folder created; please copy the appropriate Access database to it and try again"

GoTo ErrorHandlerExit

Else

MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description

Resume ErrorHandlerExit

End If

End Sub

Code B:

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 <> olAppointmentItem 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 = "Personal 2000.mdb"

strDBNameAndPath = strAccessPath & 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("TransportDate")

If TypeName(prp) <> "Nothing" Then

If prp.Value <> 0 Then

rst!TransportDate = 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

ErrorHandler:

If Err.Number = 76 Then

Set fld = fso.CreateFolder(strAccessPath)

MsgBox strAccessPath & _

" folder created; please copy the appropriate Access database to it and try again"

GoTo ErrorHandlerExit

Else

MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description

Resume ErrorHandlerExit

End If

End Sub
 
K

Ken Slovak - [MVP - Outlook]

Try olAppointment.

You really should be looking in the Object Browser for the members of the

Class enum.

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

news:ONT2WCBVKHA.1792@TK2MSFTNGP04.phx.gbl...
> Thank you in advance for any help.
> I have this code as an example that imports contact into access. Second
> code is an attempt to enter existing appointment from a calendar into
> access. Can not pass MsgBox "The active Inspector is not a contact item;
> exiting" error. Code A works fine for contacts.

> Code A:

> Option Explicit
> Private ins As Outlook.Inspector
> Private itm As Object
> Private con As Outlook.ContactItem
> 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 <> olContact Then
> MsgBox "The active Inspector is not a contact item; exiting"
> GoTo ErrorHandlerExit
> Else
> Set con = itm
> 'Pick up path to Access database directory from Access SysCmd
> function
> 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 = "Personal 2000.mdb"
> strDBNameAndPath = strAccessPath & 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("tblContacts")
> rst.AddNew
> If con.Title <> "" Then
> rst!Title = con.Title
> 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

> ErrorHandler:
> If Err.Number = 76 Then
> Set fld = fso.CreateFolder(strAccessPath)
> MsgBox strAccessPath & _
> " folder created; please copy the appropriate Access database to
> it and try again"
> GoTo ErrorHandlerExit
> Else
> MsgBox "Error No: " & Err.Number & "; Description: " &
> Err.Description
> Resume ErrorHandlerExit
> End If

> End Sub

> Code B:

> 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 <> olAppointmentItem 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 = "Personal 2000.mdb"
> strDBNameAndPath = strAccessPath & 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("TransportDate")
> If TypeName(prp) <> "Nothing" Then
> If prp.Value <> 0 Then
> rst!TransportDate = 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

> ErrorHandler:
> If Err.Number = 76 Then
> Set fld = fso.CreateFolder(strAccessPath)
> MsgBox strAccessPath & _
> " folder created; please copy the appropriate Access database to
> it and try again"
> GoTo ErrorHandlerExit
> Else
> MsgBox "Error No: " & Err.Number & "; Description: " &
> Err.Description
> Resume ErrorHandlerExit
> End If

> End Sub

>
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
D Lost Access to Custom Form Outlook VBA and Custom Forms 4
D populating listbox on custom form from Access Outlook VBA and Custom Forms 7
G Adding a contact to Outlook with a custom form using Access VBA Outlook VBA and Custom Forms 1
M Cannot access the Form Editor BCM (Business Contact Manager) 1
M open outlook calendar from an access form Using Outlook 4
M open outlook contacts in access 2007 form Using Outlook 1
P Hyperlink to Access record/Form Outlook VBA and Custom Forms 2
V How do I unblock access to the form template file? Outlook VBA and Custom Forms 1
D "Outlook has blocked access to this form template file. Outlook VBA and Custom Forms 3
B Outlook 2007 form into access field format Outlook VBA and Custom Forms 9
J access within outlook form Outlook VBA and Custom Forms 1
E Access Form from outlook? Outlook VBA and Custom Forms 4
Witzker Outlook 2019 How to get a Photo in a User Defined Contact form Outlook VBA and Custom Forms 2
Witzker Outlook 2019 Macro to send an Email Template from User Defined Contact Form Outlook VBA and Custom Forms 0
Witzker Set Cursor & Focus from any field to the body of a user Contact form in OL 2019 Outlook VBA and Custom Forms 1
Witzker Place cursor at opening, a user defined OL contact form Outlook VBA and Custom Forms 3
T Customized form: The Forward option shows write layout Outlook VBA and Custom Forms 0
T 1:1 Datatransfer from incoming mail body to customs form body Outlook VBA and Custom Forms 0
V Latest Changes to form not appearing for some users Outlook VBA and Custom Forms 3
J Does the .fdm contain my custom form? How to make ol use it? - ol2007 Outlook VBA and Custom Forms 4
J ol2021 custom form not displaying pics Outlook VBA and Custom Forms 37
bdsermons Outlook 365 command button in outlook form Outlook VBA and Custom Forms 5
wayneame Changing the Form Used by Existing Task Items in a Folder Outlook VBA and Custom Forms 4
N Contact Form Notes Field Touch vs Mouse Using Outlook 0
cbufacchi Outlook 365 Populate custom Outlook Appoint form Outlook VBA and Custom Forms 2
C Create Meeting With Custom Form Outlook VBA and Custom Forms 2
W Designer Form 2013 and Script ? how ? Outlook VBA and Custom Forms 1
J Read Outlook Form fields Outlook VBA and Custom Forms 3
V Compound IF, OR, AND in Outlook form Outlook VBA and Custom Forms 4
J custom form not displaying pictures Outlook VBA and Custom Forms 7
I Button PDF in Outlook Contact custom form Outlook VBA and Custom Forms 1
K Font Sizing in Custom Form Regions for Contacts Outlook VBA and Custom Forms 1
V Validating Outlook form with "OR" and "AND" Outlook VBA and Custom Forms 1
M Outlook 2010 How could I globally redesign an outlook template form/region/inspector template used to display mail lists or an individual mails? Outlook VBA and Custom Forms 0
A How to stop user form from disapearing once mail window is closed? Outlook VBA and Custom Forms 0
K can't get custom form to update multiple contacts using VBA Outlook VBA and Custom Forms 3
V Form data not sending for some users Outlook VBA and Custom Forms 2
H Custom Outlook Contact Form VBA Outlook VBA and Custom Forms 1
Witzker HowTo Change message Class of contact form Outlook VBA and Custom Forms 0
A VBscript stops running after updating form Outlook VBA and Custom Forms 1
Witzker HowTo start a macro with an Button in OL contact form Outlook VBA and Custom Forms 12
D Emailed form is blank Outlook VBA and Custom Forms 0
F Validation on custom task form after task acceptance Outlook VBA and Custom Forms 1
C Add Form to Appointments Received, Automatically Outlook VBA and Custom Forms 6
V Date and/or time error in Outlook Form Outlook VBA and Custom Forms 0
A Form Position with Dual Monitors Outlook VBA and Custom Forms 2
I Error saving screenshots in a custom form in outlook 2016, outlook 365 - ok in outlook 2013, outlook 2010 Outlook VBA and Custom Forms 5
M VbScript for Command Button on Contacts Custom Form Using Outlook 1
G Other users can't see P.2 with custom fields in Form Outlook VBA and Custom Forms 0
O Create a custom contact form - questions before messing things up... Outlook VBA and Custom Forms 4

Similar threads

Top