Lime,
Here is some code from an app I have used at work.
Rather than importing the information this form creates the connection to
the database and then inserts the data into the table.
The code may be incomplete and need some tweaking. I just did a quick trim
down on it to make it easier to follow.
It first sets all the variables and establishes a MAPI session to Outlook.
The rest of the code is controlled by actions on the form.
You would need a button to write the form data into the database.
Also, on exiting the form it tests to see if the data has been written to
the database and gives a message. You can have it force the data write,
cancel the close of the form or whatever you want at that point depending on
your apps needs, this just gives you a way to test.
My field names are still in use and a reference to one of the page tabs
called Details. You will have to modify them to suit your own needs but
this should get you started.
'Global Variables
Dim FolderLocation 'Used to store the location of the Public Folder
Dim CurrentUser
Dim ActiveFolder
Dim MyDB 'Used to store the DAO Database Object
Dim MyRS
Dim ErrorDetected 'Used to detect a run-time error
Dim TabForField
Dim OleMsgSession
Dim foundit
'***********************************************************
' Open Item Processing
'***********************************************************
Function Item_Open
on error resume next
Err.Clear
InitializeOutlookVariables
End Function
'***********************************************************
'* InitializeOutlookVariables
'* Initializes the needed Outlook variables and places
'* the returned values in global variables
'***********************************************************
sub InitializeOutlookVariables
set oNameSpace = Application.GetNameSpace("MAPI")
currentuser = oNameSpace.CurrentUser
Set OleMsgSession = application.CreateObject("MAPI.Session")
OleMsgSession.Logon "", "", False, False, 0
end sub
'***********************************************************
'* Open Database
'***********************************************************
sub OpenDatabase
on error resume next
Set ActiveFolder = Application.GetNameSpace("MAPI").Folders("Public
Folders").Folders("All Public
Folders").Folders("Name_Of_Folder_In_All_Public_Folders").Folders("Name_Of_A
dditional_Subfolder").Folders("Name_Of_Folder_Form_Resides_In")
' Set dbe = item.application.CreateObject("DAO.DBEngine.35") ' For Access
97 database
Set dbe = item.application.CreateObject("DAO.DBEngine.36") 'For Access
2000 database
if err.Number <> 0 Then
MsgBox "There is an error creating database object."
Exit Sub
End If
Set MyDb =
dbe.Workspaces(0).OpenDatabase("\\servername\foldername\mydb.mdb")
If Err.Number <> 0 Then
MsgBox "There is an error accessing the database."
Exit Sub
End If
end sub
'***********************************************************
'* Copy data to Access for summary reporting
'***********************************************************
Sub cmdSendtoDatabase_click ()
on error resume next
err.clear
OpenDatabase
'Build variables for SQL
ProjNum = CheckChar(TabforField.Controls("txtProjNumber").Value)
ProjDesc = CheckChar(TabforField.Controls("txtProjDesc").Value)
NameSubject = CheckChar(item.subject)
DateRec = ""
If not TabforField.Controls("txtDateRec").Value = #1/1/4501# then DateRec =
TabforField.Controls("txtDateRec").Value
NumPeople = CheckChar(TabforField.Controls("txtNumPP").Value)
Loc = UCase(item.location)
' Make sure all fields are filled in
If ProjNum = "" then
msgbox "No Project number entered."
msgbox "Not sent to database."
Exit sub
End If
If ProjDesc = "" then
msgbox "No description entered."
msgbox "Not sent to database."
Exit sub
End If
If NameSubject = "" then
msgbox "No name/subject entered."
msgbox "Not sent to database."
Exit sub
End If
If DateRec = "" then
msgbox "No date received entered."
msgbox "Not sent to database."
Exit sub
End If
If NumPeople = "" then
msgbox "Number of people not entered."
msgbox "Not sent to database."
Exit sub
End If
If Loc = "" then
msgbox "No location entered."
msgbox "Not sent to database."
Exit sub
End If
'See if exists already
CheckforRecord ProjNum
If foundit = 1 then
msgbox "Project Number already in use!"
msgbox "Record not saved, use another number and try again."
Exit Sub
End If
strInsertSQL = "INSERT INTO mytable (ProjectNumber, ProjectDesc,
NameSubject, DateReceived, NumberofPeople, Location) VALUES " _
& "('" & ProjNum & "','" & ProjDesc & "','" & NameSubject & "','" &
DateRec & "','" & NumPeople & "','" & Loc & "');"
err.clear
mydb.Execute strInsertSQL
if err.number <> 0 then
MsgBox err.number & " There is an error storing the data to Access."
else
MsgBox "Database update successful."
end if
dbe.CloseCurrentDatabase
Set dbe = Nothing
End Sub
'***********************************************************
'* Check for Invalid Characters (' or ")
'***********************************************************
Function CheckChar(holdtext)
While Instr(holdtext,"""")
pos=Instr(holdtext,"""")
holdtext = left(holdtext,pos-1)&right(holdtext,len(holdtext)-pos)
Wend
While Instr(holdtext,"'")
pos=Instr(holdtext,"'")
holdtext = left(holdtext,pos-1)&right(holdtext,len(holdtext)-pos)
Wend
CheckChar = holdtext
end Function
'*****************************************************************
' Make sure it was sent to database before close
'*****************************************************************
Function Item_Close()
OpenDatabase
set TabforField =
application.activeinspector.modifiedformpages.item("Details")
ProjNum = CheckChar(TabforField.Controls("txtProjNumber").Value)
CheckforRecord ProjNum
If foundit = 0 then
Msgbox "No record was found for this activity on the database!"
'Item_Close = False
End If
If not Item.Saved Then
Item.Save
End If
Set OleMsgSession = Nothing
OleMsgSession.Logoff
dbe.CloseCurrentDatabase
Set dbe = Nothing
End Function
