A Microsoft Outlook email forum. Outlook Banter

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » Outlook Banter forum » Microsoft Outlook Email Newsgroups » Outlook and VBA
Site Map Home Register Authors List Search Today's Posts Mark Forums Read Web Partners

Form into access



 
 
Thread Tools Search this Thread Display Modes
  #1  
Old October 23rd 09, 07:42 PM posted to microsoft.public.outlook.program_vba
Bear
external usenet poster
 
Posts: 28
Default Form into access

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

Ads
  #2  
Old October 23rd 09, 09:55 PM posted to microsoft.public.outlook.program_vba
Ken Slovak - [MVP - Outlook]
external usenet poster
 
Posts: 5,848
Default Form into access

Try olAppointment.

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

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm


"bear" swin_1234[at]yahoo[dot]com wrote in message
...
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


Submitted using http://www.outlookforums.com


  #3  
Old October 27th 09, 11:09 PM posted to microsoft.public.outlook.program_vba
Bear
external usenet poster
 
Posts: 28
Default Form into access

Thanks it worked.
Submitted using http://www.outlookforums.com
 




Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
access within outlook form Joel Allen Outlook - Using Forms 1 October 7th 09 02:06 AM
Access Form from outlook? Edward[_2_] Outlook and VBA 3 August 20th 09 10:11 AM
Sending Custom Form from Access Boyd Outlook - Using Forms 1 May 16th 08 06:11 PM
VBA access to controlelement in a form Markus Beck Outlook and VBA 3 July 17th 07 06:22 PM
Using Access to design a form and then publish it djb Outlook - General Queries 3 September 14th 06 05:22 PM


All times are GMT +1. The time now is 03:33 PM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.Search Engine Friendly URLs by vBSEO 2.4.0
Copyright ©2004-2024 Outlook Banter.
The comments are property of their posters.