Automatically Attach an Excel File to an Email

R

ryguy7272

I am using the code below to automatically open an email and populate the
recipient, subject, and body of the email (recipient details are saved in a
table). The code works fine. I'd like to take this one step further and see
if I can automatically attach a file to the email as the email is opened.
The Excel file will be saved on my desktop and will be named 'Class2'. Is
there any way to modify the code to do this?

Option Compare Database

Private Sub cmdMailTicket_Click()
On Error GoTo Err_cmdMailTicket_Click


Dim varTo As Variant '-- Address for SendObject
Dim stText As String '-- E-mail text
Dim RecDate As Variant '-- Rec date for e-mail text
Dim stSubject As String '-- Subject line of e-mail
Dim strSQL As String '-- Create SQL update statement
Dim errLoop As Error


varTo = DLookup("[strEMail]", "tblUsers") ', stWhere)

stSubject = "Class 2 Pipe"

stText = "Colleen, please see the attachment." & Chr$(13) & Chr$(13) & _
"Thanks," & RecDate & Chr$(13) & Chr$(13) & _
"Ryan---"

'Write the e-mail content for sending to assignee
DoCmd.SendObject , , acFormatTXT, varTo, , , stSubject, stText, -1

'Set the update statement to disable command button
'once e-mail is sent
strSQL = "UPDATE tblHelpDeskTickets SET
tblHelpDeskTickets.ysnTicketAssigned = -1 " & _
"Where tblHelpDeskTickets.lngTicketID = " & ";"


On Error GoTo Err_Execute
CurrentDb.Execute strSQL, dbFailOnError
On Error GoTo 0

Exit Sub

Err_Execute:

' Notify user of any errors that result from executing the query.
If DBEngine.Errors.Count > 0 Then
For Each errLoop In DBEngine.Errors
MsgBox "Error number: " & errLoop.Number & vbCr & _
errLoop.Description
Next errLoop
End If

Resume Next


Exit_cmdMailTicket_Click:
Exit Sub

Err_cmdMailTicket_Click:
MsgBox Err.Description
Resume Exit_cmdMailTicket_Click

End Sub


Regards,
Ryan---
 
R

Rick Brandt

ryguy7272 said:
I am using the code below to automatically open an email and populate
the recipient, subject, and body of the email (recipient details are
saved in a table). The code works fine. I'd like to take this one
step further and see if I can automatically attach a file to the
email as the email is opened. The Excel file will be saved on my
desktop and will be named 'Class2'. Is there any way to modify the
code to do this?
Click to expand...

No. SendObject can only create attachments from Access objects on-the-fly
to attach them to the mail message. It cannot attach files stored on disk.
You would need to automate an external messaging library like Outlook or CDO
to do that.
 
R

ryguy7272

Ah! Thanks for saving me time trying to figure out how to do this, and
eventually realizing I can't do it.


Regards,
Ryan---
 
T

Ted

This code works great. I've taken a lot of stuff out, as I normally keep
prompting the user to ask if they want to add another attachment and then do
so until they answer no. I've taken that kind of stuff out so you have clean
straightforward code...but there is so much you can do with Access!

I use global application settings tables to store such things as this
particular file you want to automatically attach all the time. Here is the
code. I hope you find it useful.

'Send Outlook Email
Function SendOutlookEmail(strEmail As String, strSubj As String, strBody
As String) As Integer
Dim strFilter As String
Dim strInputFileName As String
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim varTo As Variant
Dim strSubject As String
Dim strText As String

varTo = DLookup("[strEMail]", "tblUsers")
strSubject = "Class 2 Pipe"
strText = "Colleen, please see the attachment." & Chr$(13) & Chr$(13) & _
"Thanks," & RecDate & Chr$(13) & Chr$(13) & _
"Ryan---"

'Check for the file that will be attached

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

' Create the message.
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 = strSubj
txtBody = "Dear " & DLookup("[First]", "tblUsers", " = '" &
strEmail & "'") & ":"
txtBody = txtBody & vbCrLf & vbCrLf & DLookup("[Text]",
"tblLetters", "[Title] = '" & Forms!frmCreateEmails!cmboSelectLetter & "'")
txtBody = txtBody & vbCrLf & vbCrLf
txtBody = txtBody & "Sincerely," & vbCrLf
txtBody = txtBody & vbCrLf & DLookup("[OwnerFirstName]",
"tblCompanyInfo") & " " & DLookup("[OwnerLastName]", "tblCompanyInfo")
txtBody = txtBody & vbCrLf & DLookup("[Title]", "tblCompanyInfo")
txtBody = txtBody & vbCrLf & DLookup("[CompShortName]",
"tblCompanyInfo")
txtBody = txtBody & vbCrLf & DLookup("[Phone]", "tblCompanyInfo")
txtBody = txtBody & vbCrLf & DLookup("[WebSite]", "tblCompanyInfo")
.Body = txtBody


Attachment_Check:

'Get the file name for the attachment from a table
If Not IsNull(DLookup("[FileName]", "tblAppGlobalSettings")) Then
'The file name IS stored, so open it
strFileName = DLookup("[FileName]", "tblAppGlobalSettings")
'before this last statement, check to be sure the file
is there,
'if it isn't use the open file dialog to find it then save
'it's path in the settings table for future use
Else
'The attachment file name is not in the settings table
'Note I'm using a couple of calls to functions in the
Modules section of my application
strFilter = ahtAddFilterItem(strFilter, "Excel
Files(*.xls)", "*.xls")
strDialogTitle = "Please Locate the FileNameHere.xls file"
strFileName = ahtCommonFileOpenSave(OpenFile:=True,
DialogTitle:=strDialogTitle, Filter:=strFilter, Flags:=ahtOFN_OVERWRITEPROMPT
Or ahtOFN_READONLY)
'Add code to save the file's path in the settings table for
future use
'Include code to check for a returned value. If they
cancelled the
'Open file procedure you will get an error unless you code
for it.
'So if there is a Null value returned, give user a message
that they
'cancelled the procedure, then give the Exit Sub command
End If
Set objOutlookAttach = .Attachments.Add(strInputFileName)
'attaches the file to the email


After_Attach_Check:

' Resolve each Recipient's name.
' This verifies each recipients email address with the contacts list
in Outlook
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next

.Send

End With

Set objOutlookMsg = Nothing
Set objOutlook = Nothing
GoTo Exit_Sub


Exit_Sub:
End Function

Error_Trapping:
MsgBox "Error: " & Err.Number & " = " & Err.Description







[QUOTE="ryguy7272"]
I am using the code below to automatically open an email and populate the
recipient, subject, and body of the email (recipient details are saved in a
table). The code works fine. I'd like to take this one step further and see
if I can automatically attach a file to the email as the email is opened.
The Excel file will be saved on my desktop and will be named 'Class2'. Is
there any way to modify the code to do this?

Option Compare Database

Private Sub cmdMailTicket_Click()
On Error GoTo Err_cmdMailTicket_Click


Dim varTo As Variant '-- Address for SendObject
Dim stText As String '-- E-mail text
Dim RecDate As Variant '-- Rec date for e-mail text
Dim stSubject As String '-- Subject line of e-mail
Dim strSQL As String '-- Create SQL update statement
Dim errLoop As Error


varTo = DLookup("[strEMail]", "tblUsers") ', stWhere)

stSubject = "Class 2 Pipe"

stText = "Colleen, please see the attachment." & Chr$(13) & Chr$(13) & _
"Thanks," & RecDate & Chr$(13) & Chr$(13) & _
"Ryan---"

'Write the e-mail content for sending to assignee
DoCmd.SendObject , , acFormatTXT, varTo, , , stSubject, stText, -1

'Set the update statement to disable command button
'once e-mail is sent
strSQL = "UPDATE tblHelpDeskTickets SET
tblHelpDeskTickets.ysnTicketAssigned = -1 " & _
"Where tblHelpDeskTickets.lngTicketID = " & ";"


On Error GoTo Err_Execute
CurrentDb.Execute strSQL, dbFailOnError
On Error GoTo 0

Exit Sub

Err_Execute:

' Notify user of any errors that result from executing the query.
If DBEngine.Errors.Count > 0 Then
For Each errLoop In DBEngine.Errors
MsgBox "Error number: " & errLoop.Number & vbCr & _
errLoop.Description
Next errLoop
End If

Resume Next


Exit_cmdMailTicket_Click:
Exit Sub

Err_cmdMailTicket_Click:
MsgBox Err.Description
Resume Exit_cmdMailTicket_Click

End Sub


Regards,
Ryan---
[/QUOTE]
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Send Email with Access 2007 2
Sending emails with Outlook from a form & Subform 1
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
Send email message from Access 1
retrieve multiple data for one criteria - urgent help. 1
Issue with Code "SendObject" 2
Multiple Email Addresses in CC - April 30th deadline! 4
Multiple fields in the CC argument 2

Top