Marie said:
Hi,
I have an Access 2003 database, and would like to set up a command button on
a form that will email 3 tables to a specific address.
At the moment I have a macro (I know this is something of a dirty word, but
due to my lack of vba knowledge was the only way I could think of!) that uses
the SendObject action, but I can only get it to send 1 table in each email.
Is there an easy way to add tables 2 and 3 to the email attachments?
All help very gratefully received.
Many thanks,
Marie
If they're always the same 3 tables, you can hard code it... (not my favorite,
because it's not very flexible...)
Option Compare Database
Option Explicit
Dim mOutlookApp As Outlook.Application
Dim mNameSpace As Outlook.NameSpace
Dim mFolder As MAPIFolder
Dim mItem As MailItem
Dim fSuccess As Boolean
' First function sets the Outlook Application
' and Namespase objects and opens MS Outlook
Public Function GetOutlook() As Boolean
On Error Resume Next
' Assume success
fSuccess = True
Set mOutlookApp = GetObject(, "Outlook.application")
' If Outlook is NOT Open, then there will be an error.
' In case of 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
GetOutlook = fSuccess
End Function
' Next function reads user entered values and
' actually sends the message
Public Function SendMessage(
ByVal strRecip As String,
ByVal strSubject As String,
ByVal strMsg As String,
Optional Byval strAttachment1 As String,
Optional Byval strAttachment2 As String,
Optional Byval strAttachment3 As String) As Boolean
On Error Resume Next
Dim intAttachment as integer
If Len(strRecip) = 0 Then
strMsg = "You must provide a recipient."
MsgBox strMsg, vbExclamation, "Error"
Exit Function
End If
' Assume success
fSuccess = True
If GetOutlook Then
Set mItem = mOutlookApp.CreateItem(olMailItem)
mItem.Recipients.Add strRecip
mItem.Subject = strSubject
mItem.Body = strMsg
If Not IsMissing(strAttachment1) Then
mItem.Attachments.Add strAttachment1
End If
If Not IsMissing(strAttachment2) Then
mItem.Attachments.Add strAttachment2
End If
If Not IsMissing(strAttachment3) Then
mItem.Attachments.Add strAttachment3
End If
mItem.Save
mItem.Send
End If
If Err.Number > 0 Then fSuccess = False
SendMessage = fSuccess
End Function
