Emailing Reports From Access, via Outlook/Outlook Express
As promised last month,
I am going to show you the code to email reports from Access through Outlook
or Outlook Express. I will not take credit for the code as being original
as it is cobbled together from a number of sources. The primary source for
much of the code is Grace Grady from one of the Access lists I am on.
I use this code as a call from my code that was
published last month. In that code, I choose to send a link to a report on
the network, however, the file can be sent as an attachment as well.
Whether or not you are interested in this topic, I
would like to hear from you on what you would like to see in this space. Is
there something troubling you? Some point about Access you just aren’t
getting? Please
let me know.
Here is the code (I have tried to comment it in
Green so that you can follow along):
' -- Begin Code Here --
Option Compare Database
Option Explicit
' Declare module level variables
Dim mOutlookApp
As Outlook.Application
Dim mNameSpace As
Outlook.NameSpace
Dim mFolder As
MAPIFolder
Dim mItem As
MailItem
Dim fSuccess As
Boolean
' Module contains only 2 methods:
' 1) GetOutlook()
' 2) SendMessage()
Private Function GetOutlook()
As Boolean
' The GetOutlook() function sets the Outlook
Application
' and Namespase objects and opens MS Outlook
On Error Resume Next
' Assume success
fSuccess =
True
Set mOutlookApp = GetObject("", "Outlook.application")
' If Outlook is NOT Open, then there will be an
error.
' Attempt to open Outlook
If Err.Number > 0
Then
Err.Clear
Set mOutlookApp =
CreateObject("Outlook.application")
If Err.Number > 0
Then
MsgBox
"Could not create Outlook object", vbCritical
fSuccess = False
Exit
Function
End If
End If
' If we've made it this far, we have an Outlook
App Object
' Now, set the NameSpace object to MAPI Namespace
Set mNameSpace
= mOutlookApp.GetNamespace("MAPI")
If Err.Number >
0 Then
MsgBox
"Could not create NameSpace object", vbCritical
fSuccess =
False
Exit Function
End If
' Return the Success Flag as the value of
GetOutlook()
GetOutlook =
fSuccess
End Function
Public Function SendMessage(strRecip
As String, strSubject
As String, strmsg
As String, strAttachment As String)
' The SendMessage() function reads user entered
values and
' actually sends the message. The user entered
values can come from fields in a table.
On Error Resume Next
' Any amount of validation could be done at this
point, but
' at a minimum, you need to verify that the user
supplied an
' Email address for a recipient.
If Len(strRecip) = 0
Then
strmsg =
"You must designate a recipient."
MsgBox
strmsg, vbExclamation, "Error"
Exit Function
End If
' Assume success
fSuccess =
True
' Here's where the real Outlook Automation takes
place
If GetOutlook =
True Then
Set mItem =
mOutlookApp.CreateItem(olMailItem)
mItem.To =
strRecip
'mItem.Recipients.Add
strRecip
mItem.Subject = strSubject
mItem.HTMLBody = strmsg
' This code allows for 1 attachment, but with
slight
' modification, you could provide for
multiple files.
If Len(strAttachment) > 0
Then
mItem.Attachments.Add strAttachment
End If
mItem.Save
mItem.Send
End If
' Release resources
Set mOutlookApp =
Nothing
Set mNameSpace =
Nothing
If Err.Number > 0
Then fSuccess = False
SendMessage =
fSuccess
End Function
' -- End Code Here -->
<<<back to contents
James La Borde works
in the computer department at a Credit Union,
where he uses Access, SQL Server, VBA, and ODBC daily. He also
teaches online Access classes at
Eclectic
Academy.
,
