Attach Email with Access using Access Outlook Application by Module

Hello,  

I would like to use the below Code to automate emailing of reports when the user starts a form in Access, but can't seem to get the

.attachment portion right.  I read it needs a Location but what I want it to pull a ready created report and email that in the background.

I don't want to use the DoCmd.SendObject

Sub SendEmail()
Dim objOutlook As Outlook.Application
Set objOutlook = New Outlook.Application

Dim objMailItem As Outlook.MailItem

With objOutlook
    Set objMailItem = .CreateItem(olMailItem)
    With objMailItem
        .Subject = "Your Daily Report for" & " " & Date
        .Body = "Please see the attachment as this contains the daily data you are looking for." & vbNewLine & vbNewLine & _
            "Regards," & vbNewLine & vbNewLine & _
            "Your Reporting Team" & vbNewLine
            
        .Recipients.Add "JDoe@jdoe.com"
        .Attachments.Add("MyReport", , , "Report_For_Date" & "_" & Date) = Attachment '(This portion needs help)
        .Send
    End With
End With
        
End Sub

Open in new window


I also have this code to that I seen online and works but never got an answer as to how to change the FileName of the Report and I wanted to supress the Printing Dialog box that shows up (it is quick on the machines, but still I don't want the user to see it)

Sub SendEmail2()


    'Set a Reference to the Microsoft Outlook ?X.X Object Library
    Dim strReportName As String
    Dim oLook As Object
    Dim oMail As Object
    Dim olns As Outlook.NameSpace
    Dim strTO As String
    Dim strMessageBody As String
    Dim strSubject As String
     
    strReportName = "MyReport"
    DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, CurrentProject.Path & _
                   "\" & strReportName & ".pdf", False
     
    Set oLook = CreateObject("Outlook.Application")
    Set olns = oLook.GetNamespace("MAPI")
    Set oMail = oLook.CreateItem(0)
     
    '*********************** USER DEFINED SECTION ************************
    strTO = "JDoe@jdoe.com"
    strMessageBody = "Here is the Report that you requested"
    strSubject = "Test Project for Attaching Access"
    '*********************************************************************
     
    With oMail
     .To = strTO
     .Body = strMessageBody
     .Subject = strSubject
     .Attachments.Add CurrentProject.Path & "\" & strReportName & ".pdf"
       '.Display
         .Send
    End With
     
    Set oMail = Nothing
    Set oLook = Nothing



End Sub

Open in new window

Ernest GroggSecurity Management InfoSecAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Jeffrey CoachmanMIS LiasonCommented:
The first code presumes that the attachment is a *File*, ...not just a report in an Access database (Listed in the Navigation Pane).
The definition of an attachment is an external disk file attached to the email.
So, if you want to use the first code, ...you will have to add some additional code to save the report out to a disk file, ...then attach it to the email.
(I am not quite sure I understand why your attachment code has that "=Attachment", ...because that is not needed.)

Since I do not have access to your application I could not test this code, ...but it should look something like this:
Sub SendEmail()
Dim objOutlook As Outlook.Application
Dim objMailItem As Outlook.MailItem

'Declare the Report full Path and Name
Dim strReportName as string

Set objOutlook = New Outlook.Application

'Set the Report full Path and Name
strReportName ="C:\YourFolder\Report_For_Date" & "_" & Date

With objOutlook
    Set objMailItem = .CreateItem(olMailItem)
    With objMailItem
        .Subject = "Your Daily Report for" & " " & Date
        .Body = "Please see the attachment as this contains the daily data you are looking for." & vbNewLine & vbNewLine & _
            "Regards," & vbNewLine & vbNewLine & _
            "Your Reporting Team" & vbNewLine
            
        .Recipients.Add "JDoe@jdoe.com"
        'Save the report to the specified location, with the specified name
        DoCmd.OutputTo acOutputReport, "MyReport", acFormatRTF, strReportName 
        
        'Attach the file to the email
        .Attachments.Add(strReportName)
        .Send
    End With
End With
        
End Sub

Open in new window


see if you can get this to work in your DB...
Post back if you have any questions.

JeffCoachman

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Ernest GroggSecurity Management InfoSecAuthor Commented:
I got it working.  I just have to test it in our environment, but currently working where I am at.  Will do this on Tuesday when back in there. I hope you don't mind waiting a couple of days.

Since we use a smart-card for email password storage and we don't allow saving of the passwords it will ask for the password or the smart-card certificate before sending if the email is not open, but in most cases the email will already be open by the time the application is up and running.

Here is what I have:

Sub SendEmail()
Dim objOutlook As Outlook.Application
Set objOutlook = New Outlook.Application
Dim strReportName As String

'set the file name of the Report that we are sending
strFileName = Month(Date) & "-" & Day(Date - 1) & "-" & Year(Date) & "-" & "My Custom Name" & ".pdf"

Dim objMailItem As Outlook.MailItem

With objOutlook
    Set objMailItem = .CreateItem(olMailItem)
    With objMailItem
        .Subject = "My Custom Name Report for" & " " & Date - 1
        .Body = "Please see the attachment as this contains the daily data you are looking for." & vbNewLine & vbNewLine & _
            "Regards," & vbNewLine & vbNewLine & _
            "Your Reporting Team" & vbNewLine
        'Add an email address to send the file to
        .Recipients.Add "myemailaddress@email.com"
        'Save the report to the specified location, with the specified name
        DoCmd.OutputTo acOutputReport, "MyActualReportNameInAccess", acFormatPDF, CurrentProject.Path & _
                   "\" & strFileName

        'Attach the file to the email
        .Attachments.Add (CurrentProject.Path & "\" & strFileName) 'Matches the above from where file saved
        'Go ahead and send the email
        .Send
    End With
End With
        
End Sub

Open in new window

Jeffrey CoachmanMIS LiasonCommented:
ok,
keep me posted
Ernest GroggSecurity Management InfoSecAuthor Commented:
OK...sorry it took so long to get back.  What I found was that since the location of the db was on the server, I had to modify the coding just a bit to be able to save and retrieve.  

The only thing I can't figure out is what I would need to do to get it to send automatically because I forgot about the Classification level Box that comes up when trying to send.  It must first be dealt with before the email can be sent. (AGM Message Classification).

Would you know or anyone know what I can do to set this via the code?  The Box comes up before sending with the send button on it and also if you close it, it goes back to the email item.
Jeffrey CoachmanMIS LiasonCommented:
Not sure what you man by:
"AGM Message Classification"

But if this is the Outlook security pop-up, ...you can avoid this by using this utility:
http://www.contextmagic.com/express-clickyes/

Jeff
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.