Kirk,
I'm not so sure it's simple. I spent a more than a few minutes putting the
following code together that I call from an Access 2007 database I created to
track engineering projects. The following function is called and passed
information including the attachment of an RFI pdf file, and optionally
several additional file attachments. Take a look at it, and see if it makes
sense for your application. BTW, you'll need to add a reference to Microsoft
Outlook 12.0 Object Library (or whatever version you're using).
Public Function fncEmailRFI(strDSiProjectNumber As String, strEmail As
String, varAttachment As Variant, strFrom As String, strTo As String,
Optional strCC As String, Optional strBCC As String, Optional
varFileAttachment1 As Variant, Optional varFileAttachment2 As Variant,
Optional varFileAttachment3 As Variant, Optional varFileAttachment4 As
Variant, Optional varFileAttachment5 As Variant) As Boolean
On Error GoTo PROC_ERROR
Dim strEmailAddress As String
Dim strEmailSubject As String
Dim strMessageBody As String
Dim objEmail As Object
'Subject
strEmailSubject = "RFI from DSi-Engineering"
'Email message
strMessageBody = "Please see the attached pdf file for RFI from
DSi-Engineering."
'The following uses Outlook for the mail client and supports file
attachments.
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
'Add the To recipient(s) to the message.
Set objOutlookRecip = .recipients.Add(strEmail)
objOutlookRecip.Type = olTo
'Set the Subject, Body, and Importance of the message.
.Subject = strEmailSubject
.Body = strMessageBody & vbCrLf & vbCrLf
.Importance = olImportanceHigh
.ReadReceiptRequested = True
If strCC <> "" Or Not IsNull(strCC) Then
.CC = strCC
End If
If strBCC <> "" Or Not IsNull(strBCC) Then
.BCC = strBCC
End If
'Add RFI Report to the message.
If varAttachment <> "" Then 'The RFI document
Set objOutlookAttach = .Attachments.Add(varAttachment)
End If
'Add optional file attachments
If varFileAttachment1 <> "" Then
Set objOutlookAttach = .Attachments.Add(varFileAttachment1)
Else:
varFileAttachment1 = ""
End If
If varFileAttachment2 <> "" Then
Set objOutlookAttach = .Attachments.Add(varFileAttachment2)
Else:
varFileAttachment2 = ""
End If
If varFileAttachment3 <> "" Then
Set objOutlookAttach = .Attachments.Add(varFileAttachment3)
Else:
varFileAttachment3 = ""
End If
If varFileAttachment4 <> "" Then
Set objOutlookAttach = .Attachments.Add(varFileAttachment4)
Else:
varFileAttachment4 = ""
End If
If varFileAttachment5 <> "" Then
Set objOutlookAttach = .Attachments.Add(varFileAttachment5)
Else:
varFileAttachment5 = ""
End If
'Resolve each Recipient's name.
For Each objOutlookRecip In .recipients
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing
'Add email to tblEmailLog
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("tblEmailLog")
With rs
.AddNew
.Fields("From").Value = strFrom
.Fields("To").Value = strTo
If strCC <> "" Or Not IsNull(strCC) Then
.Fields("CC").Value = strCC
End If
If strBCC <> "" Or Not IsNull(strBCC) Then
.Fields("BCC").Value = strBCC
End If
.Fields("Attachment") = varAttachment
If IsNull(varFileAttachment1) Then
'Don't add it
Else:
.Fields("FileAttachment1").Value = CStr(varFileAttachment1)
End If
If IsNull(varFileAttachment2) Then
'Don't add it
Else:
.Fields("FileAttachment2").Value = CStr(varFileAttachment2)
End If
If IsNull(varFileAttachment3) Then
'Don't add it
Else:
.Fields("FileAttachment3").Value = CStr(varFileAttachment3)
End If
If IsNull(varFileAttachment4) Then
'Don't add it
Else:
.Fields("FileAttachment4").Value = CStr(varFileAttachment4)
End If
If IsNull(varFileAttachment5) Then
'Don't add it
Else:
.Fields("FileAttachment5").Value = CStr(varFileAttachment5)
End If
.Fields("Subject").Value = strEmailSubject
.Fields("Message").Value = strMessageBody
.Fields("EmailDate").Value = Now()
.Fields("ToID").Value = fncGetContactID(strTo)
.Fields("LinkedToProject").Value = strDSiProjectNumber
.Update
End With
rs.Close
Set rs = Nothing
fncEmailRFI = True
PROC_EXIT:
Exit Function
PROC_ERROR:
Select Case Err.Number
Case "287"
MsgBox "You clicked No to the Outlook security warning. " & _
"Rerun the procedure and click Yes to access e-mail" & _
"addresses to send your message. For more information, " & _
"see the document at
http://www.microsoft.com/office" & _
"/previous/outlook/downloads/security.asp."
Case Else
Call ShowError("fncEmailRFI", Err.Number, Err.Description)
Resume PROC_EXIT
Resume
End Select
End Function
IKMD66 said:
Hi,
Hopefully this is a simple one. I would like to use a number of form buttons
to send specific PDF documents attached in a table.
The table where the PDF document resides is called [EFORMS]. The table has
two colums [DESCRIPTION] and [EFORM]. Each button on the form would link
directly to one PDF in the table. When the button is pressed I would like
Outlook to open up with the PDF attached, the cursor placed in the 'To'
field, the subject field filled and some body text.
Can anyone point me in the righ direction or better still provide sample
code.?
Thanks in advance.
Regards,
Kirk
