Question Send Access Report in pdf attachment by outlook to No of Contacts

Sir,

i am working or reports on my DB
i am able to convert reports in pdf format with specific file name and save that file in Document folder

Now my concern is to send that pdf report to no of Recepients
with Subject and Body of Email

i tried from morning but not succeed fully , here is my last mess up script
kindly anybody can help me

Private Sub Command45_Click()
Dim strReportName As String
Dim strPathUser As String
Dim strFilePath As String
Dim rst As DAO.Recordset
Dim strEmailAddress
Dim EmailApp, NameSpace, EmailSend As Object
'set variables
strReportName = "006-10 Years Business Plan"
strPathUser = Environ$("USERPROFILE") & "\my documents"
strFilePath = strPathUser & strReportName & Format(Date, "yyyymmdd") & ".pdf"
'export to PDF/EXCEL
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, strFilePath
Set EmailApp = CreateObject("Outlook.Application")
Set NameSpace = EmailApp.getNameSpace("MAPI")
Set EmailSend = EmailApp.CreateItem(0)
EmailSend.To = "mailaddress"
EmailSend.Subject = "EMERGENCY"
EmailSend.Attachment.Add strPathUser
EmailSend.Display

End Sub



CODE TO CONVERT AND SAVE THE REPORT IS
Private Sub Command43_Click()
Dim strReportName As String
Dim strPathUser As String
Dim strFilePath As String
'set variables
strReportName = "006-10 Years Business Plan"
strPathUser = Environ$("USERPROFILE") & "\my documents"
strFilePath = strPathUser & strReportName & Format(Date, "yyyymmdd") & ".pdf"
'export to PDF/EXCEL
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, strFilePath
'launch excel file
Dim Shex As Object
Set Shex = CreateObject("Shell.Application")
Shex.Open (strFilePath)
End Sub

Change this portion :

EmailSend.Attachment.Add strPathUser

To

EmailSend.Attachment.Add strFilePath

modify this part to:

...
...
Docmd.OutputTo acOutputReport, strReportName, acFormatPDF, strFilePath
Set NameSpace = EmailApp.getNameSpace("MAPI")
Set EmailSend = NameSpace.CreateItem(0)
With EmailSend
.To = "mailaddress"
.Subject = "EMERGENCY"
.Attachment.Add strFilePath
.Display
'.Send
End With

End Sub

Sir I have updated the below code as per your quidelines
but got Run Time Error 424 on
Set NameSpace = EmailApp.getNameSpace("MAPI")


Private Sub Command45_Click()
Dim strReportName As String
Dim strPathUser As String
Dim strFilePath As String
Dim rst As DAO.Recordset
Dim strEmailAddress
Dim EmailApp, NameSpace, EmailSend As Object
'set variables
strReportName = "006-10 Years Business Plan"
strPathUser = Environ$("USERPROFILE") & "\my documents"
strFilePath = strPathUser & strReportName & Format(Date, "yyyymmdd") & ".pdf"
'export to PDF/EXCEL
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, strFilePath
''Set EmailApp = CreateObject("Outlook.Application")
Set NameSpace = EmailApp.getNameSpace("MAPI")
Set EmailSend = NameSpace.CreateItem(0)
With EmailSend
.To ="Address"
.Subject = "EMERGENCY"
.body = "Here are the reports in pdf format"
.Attachment.Add strFilePath
.Display
'.Send
End With
End Sub

Check Set EmailApp, it has quotation in front. Remove them.

Sir,
here is the updated file still get the same error I really stucked..

Thanks for your help



Private Sub Command45_Click()
Dim strReportName As String
Dim strPathUser As String
Dim strFilePath As String
Dim rst As DAO.Recordset
Dim strEmailAddress
Dim EmailApp, NameSpace, EmailSend As Object
'set variables
strReportName = "006-10 Years Business Plan"
strPathUser = Environ$("USERPROFILE") & "\my documents"
strFilePath = strPathUser & strReportName & Format(Date, "yyyymmdd") & ".pdf"
'export to PDF/EXCEL
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, strFilePath
Set EmailApp = CreateObject("Outlook.Application")
Set NameSpace = EmailApp.getNameSpace("MAPI")
Set EmailSend = NameSpace.CreateItem(0)
EmailSend.Attachment.Add strFilePath
With EmailSend
.To = "mailaddress"
.Subject = "EMERGENCY"
.body = "Here are the reports in pdf format"
.Attachment.Add strFilePath
.Display
'.Send
End With
End Sub

I Tried by another way but here I got Run time Error
You don't have appropriate permission to perform this Operation
and error lead me to this code
.attachments.Add strFilePath

here below is the code

Private Sub Command45_Click()
Dim strReportName As String
Dim strPathUser As String
Dim strFilePath As String
Dim appOutLook As Object
Dim MailOutLook As Object

'set variables
strReportName = "005-2 Years Business Plan"
strPathUser = Environ$("USERPROFILE") & "\my documents"
strFilePath = strPathUser & strReportName & Format(Date, "yyyy-mmm-dd") & ".pdf"
'assign our object references
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
'set the recipient list
.To = "email"

'set the subject
.Subject = "2 Years Business Plan"

'set the body text
.body = "Here are the reports in pdf format"

'add the reports we created
.attachments.Add strFilePath
''.attachments.Add "c:\someLocation\Report2.pdf"

'send the email
.Send
End With

'tidy up..

'get rid of our object references
Set appOutLook = Nothing
Set MailOutLook = Nothing
'delete our temporary files
Kill strFilePath

End Sub


i want to finish this task by today thanks sir

add Reference to Microsoft Outlook X.XX Object
Library in VBE (Tools->Reference).

i tested this one and it is working.
copy and replaced your Command45_Click().

Thanks Arnel it works,
But I would like to try and learn from you the way to get the email addresses subject and body of email automatically from a table ,

actually I have multiuser and navigation form in my database
I also want that if some on login and he will get his department filtered email
I will work on it for the time its something very good.

Sir ,
I also want your help if you can see my other thread related to checklist
https://www.access-programmers.co.uk/forums/showthread.php?t=296562
I want to sort it out , I am confused in both module and scripts I put on form event
there is duplication

you don't need email body and email subject
on your table because you will be sending
a uniform email to all address from your table.
you need only email address on your table.
here is a sample of how to add email address
from table.

replace the tablename with your table and
the eMailAddressFieldHere with correct
email address field from your table:

Dear Arnel,

its not calling the subject and body text of the email
I know why because I haven't put the code in Module ,
but the reason behind I prefer repeating code to each Command button for different email
because I each email will have different Report if its fixed then I could paste once in module and then call ?
what is your opinion about this

and also I want to add CC address in email?

Sir Arnel,

I have worked on it and modified the code to get the required task
its working perfect for me
Kindly have look and if there you find any correction ?


Private Sub Command43_Click()
Dim strReportName As String
Dim strPathUser As String
Dim strFilePath As String
'set variables
strReportName = "006-10 Years Business Plan"
strPathUser = Environ$("USERPROFILE") & "\my documents"
strFilePath = strPathUser & strReportName & Format(Date, "yyyymmdd") & ".pdf"
'export to PDF/EXCEL
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, strFilePath
'launch excel file
Dim Shex As Object
Set Shex = CreateObject("Shell.Application")
Shex.Open (strFilePath)
End Sub
Private Sub Command44_Click()

End Sub
Private Sub Command278_Click()
Dim strReportName As String
Dim strPathUser As String
Dim strFilePath As String
Dim rst As DAO.Recordset
Dim strEmailAddress
Dim EmailApp, NameSpace, EmailSend As Object
'set variables
strReportName = "006-10 Years Business Plan"
strPathUser = Environ$("USERPROFILE") & "\my documents"
strFilePath = strPathUser & strReportName & Format(Date, "yyyymmdd") & ".pdf"
'export to PDF/EXCEL
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, strFilePath
Set EmailApp = CreateObject("Outlook.Application")
Set NameSpace = EmailApp.GetNamespace("MAPI")
Set EmailSend = NameSpace.CreateItem(0)
EmailSend.Attachment.Add strFilePath
With EmailSend
.To = "muhammadfarhan.shahid@aramco.com"
.Subject = "EMERGENCY"
.Body = "Here are the reports in pdf format"
.Attachment.Add strFilePath
.Display
'.Send
End With
End Sub
''Private Sub Command45_Click()
''Call SendMail(Subject:="EMERGENCY", MessageBody:="sample report for review")
''End Sub

Private Sub Command45_Click()
Dim strSubject As String
Dim strMessageBody As String
Dim strReportName As String
Dim strPathUser As String
Dim strFilePath As String
Dim strTO As String
Dim strCC As String
Dim rstTO As DAO.Recordset
Dim rstCC As DAO.Recordset
Dim EmailApp As Outlook.Application
Dim NameSpace As Outlook.NameSpace
Dim Folder As Outlook.Folder
Dim EmailSend As Outlook.MailItem

'set variables
strReportName = "005-2 Years Business Plan"
strPathUser = Environ("UserProfile") & "\Documents"
strFilePath = strPathUser & strReportName & "_" & Format(Date, "dd-mmm-yyyy") & ".pdf"
'Define Subject & Body of Email
strSubject = strReportName & "_" & Format(Date, "dd-mmm-yyyy")
strMessageBody = "Gentleman, Greetings..." & vbNewLine & vbNewLine & _
"Please Find attached Updated Report for your information. " & vbNewLine & _
"If you have any query dont hesitate to contact LROW Unit" & vbNewLine & _
"Best Regards" & vbNewLine & _
"" & vbNewLine & _
"Project Coordination Divisison"
'delete if file already exist, so we generate new pdf
If Dir(strFilePath) <> "" Then Kill strFilePath

'export to PDF/EXCEL
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, strFilePath

'create email
Set EmailApp = New Outlook.Application
Set NameSpace = EmailApp.GetNamespace("MAPI")
Set Folder = NameSpace.GetDefaultFolder(olFolderInbox)
Set EmailSend = Folder.Items.Add(olMailItem)

'OPEN ANS SET RECORDSET
Set rstTO = CurrentDb.OpenRecordset("EmailRecepients", dbOpenSnapshot)
Set rstCC = CurrentDb.OpenRecordset("EmailRecepients", dbOpenSnapshot)

''''If Not (rst.BOF And rst.EOF) Then rstTO.MoveFirst
'[TO] & [CC] IS FIELD NAMES
' here we use the recordset for email address and body
rstTO.MoveFirst
Do While Not rstTO.EOF
strTO = rstTO![To] & "; " & strTO
rstTO.MoveNext
Loop
rstCC.MoveFirst
Do While Not rstCC.EOF
strCC = rstCC![CC] & "; " & strCC
rstCC.MoveNext
Loop
With EmailSend

.Subject = strSubject
.Body = strMessageBody
.Attachments.Add strFilePath
.ReadReceiptRequested = False


' here we use the recordset for email address and body
'Do While Not rst.EOF
'strTO = strTO & rst!To & ";"
'strCC = strCC & rst!CC & ";"
'rst.MoveNext
'Loop
.To = strTO
.CC = strCC
.Display
'.Send
End With
rstTO.Close
rstCC.Close

Set rstTO = Nothing
Set rstCC = Nothing
End Sub