Question Send Access Report in pdf attachment by outlook to No of Contacts (1 Viewer)

farhanleos

Registered User.
Local time
Today, 09:50
Joined
Oct 19, 2017
Messages
38
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
 

arnelgp

error reading drive A:
Local time
Tomorrow, 00:50
Joined
May 7, 2009
Messages
8,813
Change this portion :

EmailSend.Attachment.Add strPathUser

To

EmailSend.Attachment.Add strFilePath
 

arnelgp

error reading drive A:
Local time
Tomorrow, 00:50
Joined
May 7, 2009
Messages
8,813
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
 

farhanleos

Registered User.
Local time
Today, 09:50
Joined
Oct 19, 2017
Messages
38
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
 

arnelgp

error reading drive A:
Local time
Tomorrow, 00:50
Joined
May 7, 2009
Messages
8,813
Check Set EmailApp, it has quotation in front. Remove them.
 

farhanleos

Registered User.
Local time
Today, 09:50
Joined
Oct 19, 2017
Messages
38
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
 

farhanleos

Registered User.
Local time
Today, 09:50
Joined
Oct 19, 2017
Messages
38
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
 

arnelgp

error reading drive A:
Local time
Tomorrow, 00:50
Joined
May 7, 2009
Messages
8,813
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().

Code:
Private Sub Command45_Click()
    Dim strReportName As String
    Dim strPathUser As String
    Dim strFilePath As String
    Dim rst As DAO.Recordset
    Dim strEmailAddress As String
    Dim EmailApp As Outlook.Application
    Dim NameSpace As Outlook.NameSpace
    Dim Folder As Outlook.Folder
    Dim EmailSend As Outlook.MailItem
    
    'set variables
    strReportName = "006-120 Years Business Plan"
    strPathUser = Environ("UserProfile") & "\Documents\"
    strFilePath = strPathUser & strReportName & Format(Date, "yyyymmdd") & ".pdf"
    
    '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)
    
    With EmailSend
        .To = "mailaddress"
        .Subject = "EMERGENCY"
        .Body = "Here are the reports in pdf format"
        .Attachments.Add strFilePath
        .ReadReceiptRequested = False
        .Display
        '.Send
    End With
End Sub
 

farhanleos

Registered User.
Local time
Today, 09:50
Joined
Oct 19, 2017
Messages
38
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
 

arnelgp

error reading drive A:
Local time
Tomorrow, 00:50
Joined
May 7, 2009
Messages
8,813
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:

Code:
Private Sub Command45_Click()
    Call SendMail(Subject:="EMERGENCY", MessageBody:="sample report for review")
End Sub


Public Sub SendMail(Subject As String, MessageBody As String)
    Dim strReportName As String
    Dim strPathUser As String
    Dim strFilePath As String
    Dim rst As DAO.Recordset
    Dim strEmailAddress As String
    Dim EmailApp As Outlook.Application
    Dim NameSpace As Outlook.NameSpace
    Dim Folder As Outlook.Folder
    Dim EmailSend As Outlook.MailItem
    
    'set variables
    'strReportName = "006-120 Years Business Plan"
    strReportName = "CheatSheet"
    strPathUser = Environ("UserProfile") & "\Documents\"
    strFilePath = strPathUser & strReportName & Format(Date, "yyyymmdd") & ".pdf"
    
    '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 your recordset here
    '
    ' You must supply the correct table name and field name
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Set rst = CurrentDb.OpenRecordset("yourTableHere", dbOpenSnapshot)
    If Not (rst.BOF And rst.EOF) Then rst.MoveFirst
    
    Dim strRecepients As String
    
    With EmailSend
        .Subject = strSubject
        .Attachments.Add strFilePath
        .ReadReceiptRequested = False
        .Body = strMessageBody
        
        ' here we use the recordset for email address and body
        Do While Not rst.EOF
            strRecepients = strRecepients & rst!eMailAddressFieldHere & ";"
            rst.MoveNext
        Loop
        .To = strRecepients
        .Display
        '.Send
    End With
    rst.Close
    Set rst = Nothing

End Sub
 

farhanleos

Registered User.
Local time
Today, 09:50
Joined
Oct 19, 2017
Messages
38
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?
 

farhanleos

Registered User.
Local time
Today, 09:50
Joined
Oct 19, 2017
Messages
38
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
 

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

Top Bottom