Project Perfect
PROJECT  PERFECT
                 Project Management Software
                          Specialists in Project Infrastructure
z Microsoft Access Development Tips

Home - Microsoft Access Development - Microsoft Access Tips

Sending Emails and Storing Hyperlinks

Send an Outlook Email from Access, create a file, then store
the file hyperlink in a table

This is one of those functions that could be done but it was clunky and manual. I had used it in a number of databases but was never happy with it. This is what I was trying to do.

In Access, open Outlook and create an Email. Send it, then create a file of the sent Email. I had used .MSG format or .PDF. All required manual steps. The file was saved and then a link created to it in an Access table.

Recently while creating a customer relationship management system, I had a need to do just that. I had a button to open Microsoft Word, transfer some name and address details into a new Word document and store the path to the saved document in Access. Excel was not much different.

When it came to Emails, I was doing some web surfing and found a product called MessageSave. By using MessageSave, and building a bit of infrastructure I can now achieve the result without a problem. You can download a sample Access 2007 database by clicking here. To get it to work will require you to download and configure MessageSave but a 30 day trial is available.

What is MessageSave. On their website it says

"Easily save Email messages outside of Outlook. Use MessageSave for Email. archiving, backup, document management, sharing, legal compliance, and much more."

All for the total cost of US$49.95 per license. Here are some screen shots. This shows the pop up message to prompt you to save the Email.

Email save

There are many options you can use to configure the software.

MessageSave Options

The key part for Access developers is that it uses an API to output some information.

Procedures - Brief Description

In Access we create a table called tblDocuments. It has a field called DocLink which is a hyperlink to a document. Here are the key steps in the process.

Button in Access Makes sure Outlook is open. Creates a new Email. in Outlook
MessageSave in Outlook
When the Email. is sent, MessageSave prompts to save the Email. and handles selection of a location and file name. When saved it calls a VBScript to execute.
VBScript creates temporary text file
The VBScript writes the saved Email. file name into a one line temporary text file.
Access reads the temporary file After the Email. is sent, control returns to Access. It reads the temporary file and writes the file name to the DocLink field in tblDocuments. It also does some housekeeping such as deleting the temporary file.

The VBA Code

There is a form that collects To, Subject and Body. You can use it or not. I included it to show how it could be used to transfer information to Outlook but you could just have a button on a form that opened a blank Email.

The first part is the establishment of the name and path of the temporary file. It is called temp.txt and is in the same location as the database. I use a generic routine funGetDBPath to find the current path.

Option Compare Database
Option Explicit

'++++++++++ Start of Declarations ++++++++++++++++++++++++++++++
'
' Requires reference to Microsoft Outlook x.x Object Library


Public strFileName As String ' The temporary text file that stores the location of the saved Email.
'
'========== End of Declarations ===============================

'++++++++++ Start of Opening Actions ++++++++++++++++++++++++++++
'
'---------------------------------------------------------------------------------------
' Procedure : Form_Open
' Author : Neville Turbit
' Date : 15/11/2011
' Purpose : Set the path to the temporary file that holds the name of the saved Outlook file
'---------------------------------------------------------------------------------------
'

Private Sub Form_Open(Cancel As Integer)
On Error GoTo Error_Form_Open

strFileName = funGetDBPath & "\temp.txt" ' Name of the temp file inc. path

Exit_Form_Open:
On Error GoTo 0
Exit Sub

Error_Form_Open:

MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: Form_frmEmailDetails" & vbCrLf & _
"Type: VBA Document" & vbCrLf & _
"Calling Procedure: Form_Open" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_Form_Open
Resume
End Sub

'---------------------------------------------------------------------------------------
' Procedure : funGetDBPath
' Author : Neville Turbit
' Date : 26/07/2010
' Purpose : Find the current database file name
'---------------------------------------------------------------------------------------
'

Public Function funGetDBPath() As String
Dim strFullPath As String
Dim intCounter As Integer

On Error GoTo Error_funGetDBPath

strFullPath = CurrentDb().Name

'--------------------------------------------------------------
' Find the "\" starting from the right of the strin
g
For intCounter = Len(strFullPath) To 1 Step -1
If Mid(strFullPath, intCounter, 1) = "\" Then
funGetDBPath = Left(strFullPath, intCounter)
Exit For
End If
Next

Exit_funGetDBPath:
On Error GoTo 0
Exit Function

Error_funGetDBPath:

MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: modGeneric" & vbCrLf & _
"Type: Module" & vbCrLf & _
"Calling Procedure: funGetDBPath" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_funGetDBPath
Resume
End Function

The next section sends the email and writes to the table. There are a number of subroutines.

One part that may need explanation is the creation of the hyperlink. An Access hyperlink is in two parts at least, separated by a #. The first part is what is displayed and the second the path to the file. I have just used the same for both parts.


'+++++++++++++ Start of Miscellaneous Buttons Click +++++++++++++++++++
'
'---------------------------------------------------------------------------------------
' Procedure : btnSendEmail_Click
' Author : Neville Turbit
' Date : 14/11/2011
' Purpose : Create an email, save it to a file, create a temporary text file of the email file location,
' read the location into a vaiable in Access, delete the temporary file, write the email file
' location to a record in tblDocuments
'---------------------------------------------------------------------------------------
'

Private Sub btnSendEmail_Click()

On Error GoTo Error_btnSendEmail_Click

'---------------------------------------------------------------
' Check if the temp file exists. If it does, delete it

If funFileExists(strFileName) Then
Kill (strFileName)
End If

'---------------------------------------------------------------
' Open a new email in Outlook

subSendEmail

'---------------------------------------------------------------
' Wait until the file is created

subWait

'---------------------------------------------------------------
' Write the details of the file to tblDocuments

subWriteDocDetails

Exit_btnSendEmail_Click:
On Error GoTo 0
Exit Sub

Error_btnSendEmail_Click:

MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: Form_frmEmailDetails" & vbCrLf & _
"Type: VBA Document" & vbCrLf & _
"Calling Procedure: btnSendEmail_Click" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_btnSendEmail_Click
Resume

End Sub

'---------------------------------------------------------------------------------------
' Procedure : subSendEmail
' Author : Neville Turbit
' Date : 14/11/2011
' Purpose : Create the email
'---------------------------------------------------------------------------------------
'

Sub subSendEmail()
Dim objOlApp As Outlook.Application
Dim objItem As Outlook.MailItem

On Error GoTo Error_subSendEmail

'---------------------------------------------------------------
' Create a new mail item

Set objOlApp = New Outlook.Application 'Create an Outlook application object
Set objItem = objOlApp.CreateItem(olMailItem) 'Create a new MailItem form

'---------------------------------------------------------------
'Build and display item. Cater for some fields not being entered (Nz)

With objItem
.To = Nz(Me.txtTo, "")
.Subject = Nz(Me.txtSubject, "")
.HTMLBody = Nz(Me.txtBody, "")
.Display
End With

Exit_subSendEmail:
On Error GoTo 0
Exit Sub

Error_subSendEmail:

MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: Form_frmEmailDetails" & vbCrLf & _
"Type: VBA Document" & vbCrLf & _
"Calling Procedure: subSendEmail" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_subSendEmail
Resume

End Sub

'---------------------------------------------------------------------------------------
' Procedure : subWriteDocDetails
' Author : Neville Turbit
' Date : 14/11/2011
' Purpose : Get the email file location from the temp file and create a record of that location in Access
'---------------------------------------------------------------------------------------
'

Public Sub subWriteDocDetails()
Dim strEmailPath As String ' Path to the saved email
Dim fso, MyFile ' File System Object
Dim strLineTextFile As String ' Line from the text file (address of email file)
Dim strSQL As String ' Create an SQL statement to update the record

On Error GoTo Error_subWriteDocDetails

'---------------------------------------------------------------
' Open the file and read from it

If funFileExists(strFileName) Then ' Check if the temp file was created
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.OpenTextFile(strFileName, 1)
strLineTextFile = MyFile.readline & "#" ' Line to be analysed
strLineTextFile = strLineTextFile & strLineTextFile ' Create hyperlink format for table

MyFile.Close ' Close the file
fso.DeleteFile (strFileName) ' Delete the temporary file
Else
Call MsgBox("No email was saved to the database. If you want to save the email" & _
" you will need to do it manually.", vbCritical, "No Email Saved")
GoTo Exit_subWriteDocDetails
End If

'---------------------------------------------------------------
' Write the record of the new file to tblDocuments

strSQL = "INSERT into tblDocuments (DocDate, DocLink)" & _
" VALUES(#" & Format(Now(), "mm/dd/yyyy") & "#, """ & strLineTextFile & """);"

subRunUpdateQuery (strSQL)

Exit_subWriteDocDetails:
On Error GoTo 0
Exit Sub

Error_subWriteDocDetails:

MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: Form_frmEmailDetails" & vbCrLf & _
"Type: VBA Document" & vbCrLf & _
"Calling Procedure: subWriteDocDetails" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_subWriteDocDetails
Resume

End Sub

'---------------------------------------------------------------------------------------
' Procedure : subWait
' Author : Neville Turbit
' Date : 14/11/2011
' Purpose : Wait until a temporary file is created from MessageSave
'---------------------------------------------------------------------------------------
'

Sub subWait()

On Error GoTo Error_subWait

Call MsgBox("Click to return.", vbInformation, "Email Sent")

Exit_subWait:
On Error GoTo 0
Exit Sub

Error_subWait:

MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: Form_frmEmailDetails" & vbCrLf & _
"Type: VBA Document" & vbCrLf & _
"Calling Procedure: subWait" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_subWait
Resume

End Sub

'---------------------------------------------------------------------------------------
' Procedure : funFileExists
' Author : Neville Turbit
' Date : 09/06/09
' Purpose : Check if an external file exists
'---------------------------------------------------------------------------------------
'

Public Function funFileExists(strPath As Variant, Optional lngType As Long) As Boolean
Dim intTest As Integer

On Error Resume Next 'Ignore errors to allow for error evaluation

intTest = GetAttr(strPath)

'Check if error exists and set response appropriately
Select Case Err.Number
Case Is = 0
funFileExists = True
Case Else
funFileExists = False
End Select

Exit_funFileExists:
On Error GoTo 0
Exit Function

End Function

'---------------------------------------------------------------------------------------
' Procedure : subRunUpdateQuery
' Author : Neville Turbit
' Date : 04/06/09
' Purpose : Run a query in the sql string passed to the sub to update some data
'---------------------------------------------------------------------------------------
'

Public Sub subRunUpdateQuery(strSQL As String)
Dim dbs As Database
Dim qdf As QueryDef

On Error GoTo Error_subRunUpdateQuery

'--------------------------------------------
' Turn on the hourglass

DoCmd.Hourglass (True)
DoCmd.SetWarnings False

'--------------------------------------------------------------
' Run the query

Set dbs = CurrentDb
Set qdf = dbs.CreateQueryDef("", strSQL) ' Create new QueryDef.
qdf.Execute dbSeeChanges ' Run the insert query

Exit_subRunUpdateQuery:
On Error GoTo 0
'--------------------------------------------------------------
' Clean up

Set dbs = Nothing
Set qdf = Nothing
strSQL = ""
DoCmd.Hourglass (False) ' Turn off the hourglass
DoCmd.SetWarnings True
Exit Sub

Error_subRunUpdateQuery:

MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: modGeneric" & vbCrLf & _
"Type: Module" & vbCrLf & _
"Calling Procedure: subRunUpdateQuery" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_subRunUpdateQuery
Resume

End Sub

Further Enhancements

There are a number of enhancements you can make. For example you can save other information to the document table, or pass a form field into the internet. This is the basic function to get you started.

Storing Received Emails

If you want to store received emails we have a similar function in the sample database to open Outlook. Use MessageSave to save the email from your Inbox, then Access will store the details.

Configuring MessageSave

The key thing in the configuration is to set the After Saving Messages, Execute field to point to the VBScript file in the download. This creates the temporary text file.

Configure MessageSave

The othe piece of critical configuration is to select the Prompt to save sent messages.

MessageSave Configuration

Download the Database

To download the database (Access 2007), Click Here

 

Return to the top