Access 2010 PDF and Email a Report Using VBA Code (1 Viewer)

HairyArse

Registered User.
Local time
Today, 20:43
Joined
Mar 31, 2005
Messages
92
Hello,

I'm using Access 2010 and found the Send to Email as PDF command indispensible. However, I have a problem in that I've hidden the main ribbon from my users which means they can't actually click that button.

Can anyone tell me the VBA code that will let me PDF and email an indiviual report based on a given unique ID. I am happy for the user to add the email address, subject and message body and for them to click send.

Thanks
 

sonof27

Registered User.
Local time
Tomorrow, 07:43
Joined
Sep 28, 2010
Messages
29
Not sure if there is a quicker way to do this in 2010 yet as I'm still navigating my way around it, but here is something like what I do. (Sorry if not posted correctly, I always forget how it is meant to go in here)

Code:
'Behind a comand button save the report as PDF file 
DoCmd.OutputTo acOutputReport, "rptReportName", acFormatPDF, "FullPathAndFileName.pdf", False
 
'follow the output with a function call to send the PDF via outlook
strValue = Email_Via_Outlook(strAddress, "Message Title ", strMessage, True, "FullPathAndFileName.PDF")
 
 
'Put this in a module somewhere
Function Email_Via_Outlook(varAddress, varSubject, varBody, DisplayMsg As Boolean, Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
On Error GoTo errorHandler
' 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(varAddress)
    objOutlookRecip.Type = olTo
    .Subject = varSubject 
    .body = varBody 
 
    ' Add attachments to the message.
    If Not IsMissing(AttachmentPath) And AttachmentPath <> "" Then
        Set objOutlookAttach = .Attachments.Add(AttachmentPath)
    End If
 
    ' Resolve each Recipient's name.
    For Each objOutlookRecip In .Recipients
        objOutlookRecip.Resolve
    Next
    ' Should we display the message before sending?
    If DisplayMsg Then
        .Display
    Else
        .Save
        .send
    End If
End With
Set objOutlook = Nothing
Exit Function
errorHandler:
errNameFrom = "Email_Via_Outlook"
MsgBox "Error occured at " errNameFrom:" & Err.Number & ";" & Err.Description
 
End Function

You may need a reference to outlook to get this to work.

Another option could be for you to create a custom ribbon and put the button you want on that ribbon instead of completely hiding the ribbon.
 

boblarson

Smeghead
Local time
Today, 13:43
Joined
Jan 12, 2001
Messages
32,059
You may need a reference to outlook to get this to work.
You don't need a reference if you change to LATE BINDING, which would entail changing this part:
Code:
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
to this:
Code:
Dim objOutlook As Object
Dim objOutlookMsg As Object
Dim objOutlookRecip As Object
Dim objOutlookAttach As Object
 

sonof27

Registered User.
Local time
Tomorrow, 07:43
Joined
Sep 28, 2010
Messages
29
Thank-you will give your suggestion a go the next time I use this function.
 

HairyArse

Registered User.
Local time
Today, 20:43
Joined
Mar 31, 2005
Messages
92
Following on from the excellent responses to this post of mine some time ago, that all works perfectly apart from the entire report is PDFed when I need only the current record based on the primary key.

How do I modify the acOutputReport function to only PDF a single record?
 

boblarson

Smeghead
Local time
Today, 13:43
Joined
Jan 12, 2001
Messages
32,059
Following on from the excellent responses to this post of mine some time ago, that all works perfectly apart from the entire report is PDFed when I need only the current record based on the primary key.

How do I modify the acOutputReport function to only PDF a single record?

You could ensure that the report has a saved query as the recordsource and then use a QueryDef object to modify the SQL of it before sending the output.
 

s_solt

New member
Local time
Today, 20:43
Joined
Aug 31, 2012
Messages
7
Why not just use the Docmd.SendObject command:



DoCmd.SendObject acSendReport, [name of report], acFormatPDF, "recipient@company.com",[cc email(s)],[bcc email(s)], [Message Subject], [MessageBody], True

Works a treat!

I am planning to add it to all my report dialogs.

Steve
 

156sting

Registered User.
Local time
Tomorrow, 04:43
Joined
Aug 23, 2012
Messages
28
hey guys,

this thread has been really really helpful.

All i needed was to print a report to pdf and this code works perfect, and it was really easy to understand.

but i would like to know, how do i set the directory to where the pdf files save, right now it just saves to My Documents.... i want it to send the pdf files to a specific folder, is this possible ?

this is the code i have right now.

Code:
' set variables
    Dim FileNamePDF As String
    Dim TheTenNum
    Dim TenementLookup
    Dim FindTenementPre
    Dim FindTenementSuff

    TenementLookup = Me.TenNum

' separate tenement number to subtract the /
    FindTenementPre = Left(TenementLookup, InStr(TenementLookup, "/") - 1)
    FindTenementSuff = Right(TenementLookup, InStr(TenementLookup, "/") + 1)
    
'set the filename
    FileNamePDF = "Form30 - " & FindTenementPre & "_" & FindTenementSuff & ".pdf"

' print to pdf document
    DoCmd.OutputTo acOutputReport, "AppToAmendForm", acFormatPDF, FileNamePDF, False
 

156sting

Registered User.
Local time
Tomorrow, 04:43
Joined
Aug 23, 2012
Messages
28
its ok i figured it out.

here is how i solved my issue... very simple really.

Code:
' set variables
    Dim FileNamePDF As String
    Dim TheTenNum
    Dim TenementLookup
    Dim FindTenementPre
    Dim FindTenementSuff
    Dim SetDirectoryPDF As String
        
' set directory to save to
    SetDirectoryPDF = "AtoADBPrints\"

    TenementLookup = Me.TenNum

' separate tenement number to subtract the /
    FindTenementPre = Left(TenementLookup, InStr(TenementLookup, "/") - 1)
    FindTenementSuff = Right(TenementLookup, InStr(TenementLookup, "/") + 1)
    
'set the filename and save location
    FileNamePDF = SetDirectoryPDF & "Form30 - " & FindTenementPre & "_" & FindTenementSuff & ".pdf"

' print to pdf document
    DoCmd.OutputTo acOutputReport, "AppToAmendForm", acFormatPDF, FileNamePDF, False

this saves to a sub-folder i created in My Documents - if someone knows how to actually save it to a specific folder outside the My Documents area, please share. I will need to know this for future development.


Sting
 

s_solt

New member
Local time
Today, 20:43
Joined
Aug 31, 2012
Messages
7
Hi Sting

You specified a folder but without an explicit drive or root, so Access assumed the path was relative to the default path, in this case My Documents.

Just specify any valid full path:

SetDirectoryPDF = "P:\Project xxx\reports\AtoADBPrints\"

etc

PS I haven't actually tried this but I'm sure it would work....

Steve
 

156sting

Registered User.
Local time
Tomorrow, 04:43
Joined
Aug 23, 2012
Messages
28
thanks a lot s_solt. i'll try this now, and let you know if it works!
 

156sting

Registered User.
Local time
Tomorrow, 04:43
Joined
Aug 23, 2012
Messages
28
YEP!! it works... who would of thought it would be that easy!!!

thanks heaps!!
 

s_solt

New member
Local time
Today, 20:43
Joined
Aug 31, 2012
Messages
7
Just to finally round this out...

If you want to send the report straight to email:

Code:
On Error Resume Next
DoCmd.SendObject acSendReport, strReport, acFormatPDF, , , , , "Report Attached"
On Error GoTo 0

Why use the On Error ?

Well, the email appears ready for any editing in a modal window. If you cancel without sending, you get an Access error. As shown you don't.

Steve
 

s_solt

New member
Local time
Today, 20:43
Joined
Aug 31, 2012
Messages
7
Finally, finally

You can use DoCmd.OutputTo instead of DoCmd.SendObject

Why not offer a combo with a list of possible formats:

Create a combobox with default value "Preview" and RowSource:
Code:
"Preview";"HTML (*.html)";"PDF Format (*.pdf)";"Rich Text Format (*.rtf)";"Microsoft Excel (*.xls)"

Then do

Code:
    If strFormat = "Preview" Then
        DoCmd.OpenReport strReport, acViewPreview
    Else
        On Error Resume Next
        DoCmd.SendObject acSendReport, strReport, strFormat, , , , , "Planchest Drawing Report Attached"
        On Error GoTo 0
    End If


Steve
 

BenHauto

New member
Local time
Today, 13:43
Joined
Sep 21, 2012
Messages
1
does anybody know why I can 't use the SendObject while my Outlook is running?? I'm using office 2010 32bit.

Also when I try to send a mail with the Outlook.Application object, I only can use this when Outlook is closed (other I get the errcode 429 ActiveX can't create object)
 

Erocker187

New member
Local time
Today, 16:43
Joined
Dec 5, 2012
Messages
3
My issue stems from this: I run a report that shows the last edited record and I need to email this report to the recipients email listed in the report. When I run the macro, everything works great, and the recipients email is populated as desired, with the exception that the email address appears like this:
@emailaddress.com#mailto: '@emailaddress.com'
Which requires the user to edit the email address in order to send the message. This cannot be the end result, as I intend to disable the edit feature and have the email report sent automatically as the record is saved.

Any suggestions?
 

DataDude

New member
Local time
Today, 16:43
Joined
Mar 7, 2013
Messages
1
Why not just use the Docmd.SendObject command:



DoCmd.SendObject acSendReport, [name of report], acFormatPDF, "recipient@company.com",[cc email(s)],[bcc email(s)], [Message Subject], [MessageBody], True

Works a treat!

I am planning to add it to all my report dialogs.

Steve

Steve,
This is simple and simple is great!!! Is there a way to attach 2 reports as pdf?
Rob
 

NoDatabaseGuru

New member
Local time
Today, 16:43
Joined
Oct 9, 2014
Messages
5
I know this is an old thread....so, I'm not sure if anyone will reply. But, how would I incorporate this to code for sending an e-mail outside of Outlook (Gmail)? I have the code to and tested the e-mail, but I need to add the attachment, then figure out how to make the module work at the touch of a button.


Please note, I am not a programmer or designer....just an amatuer using Access to manage multiple spreadsheets from outside sources.
 

lucy1216

Registered User.
Local time
Today, 13:43
Joined
Feb 28, 2013
Messages
11
I used Allen Brown's code and made modifications to it:

SQL:
Private Sub cmdEmailConfirmed_Click()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim oOApp_001 As Outlook.Application
Dim oOMail_001 As Outlook.MailItem
Dim distro As String
Dim strSql As String
Set db = CurrentDb()
'Sets the email distro and subject line to blank
distro = ""
Set oOApp_001 = CreateObject("Outlook.Application")
Set oOMail_001 = oOApp_001.CreateItem(olMailItem)

strSql = "SELECT tblReceiveTemp.ATTReceiveStatus, tblReceiveTemp.SprintReceiveStatus, tblReceiveTemp.VerizonReceiveStatus, tblReceiveTemp.[Level 1Approver Email], tblReceiveTemp.[Level 1Approver]" & _
" FROM tblReceiveTemp " & _
" WHERE tblReceiveTemp.ATTReceiveStatus = 'NR'OR tblReceiveTemp.SprintReceiveStatus = 'NR' OR tblReceiveTemp.VerizonReceiveStatus = 'NR'"
Set rst = db.OpenRecordset(strSql, dbOpenDynaset)
'If recordset is empty, exit
Do While Not rst.EOF
distro = distro & ";" & rst.Fields("[Level 1Approver Email]")
  
rst.MoveNext
Loop
With oOMail_001
'now use the variable disto with all the email names in the to field of outlook
'.CC =
.BCC = distro
.Subject = "ATT, Sprint and Verizon Wireless Telecommunication Approval - Reminder 1"
.Body = "Body"
.display
.BodyFormat = 1
End With
rst.Close
Set rst = Nothing
Set db = Nothing
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryATTEmailUpdate2"
DoCmd.OpenQuery "qrySprintEmailUpdate2"
DoCmd.OpenQuery "qryVerizonEmailUpdate2"
DoCmd.SetWarnings True
End Sub
Private Sub cmdEmailConfirmed2_Click()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim oOApp_001 As Outlook.Application
Dim oOMail_001 As Outlook.MailItem
Dim distro As String
Dim strSql As String
Set db = CurrentDb()
'Sets the email distro and subject line to blank
distro = ""
Set oOApp_001 = CreateObject("Outlook.Application")
Set oOMail_001 = oOApp_001.CreateItem(olMailItem)

strSql = "SELECT tblReceiveTemp.ATTReceiveStatus, tblReceiveTemp.SprintReceiveStatus, tblReceiveTemp.VerizonReceiveStatus, tblReceiveTemp.[Level 1Approver Email], tblReceiveTemp.[Level 1Approver]" & _
" FROM tblReceiveTemp " & _
" WHERE tblReceiveTemp.ATTReceiveStatus = 'NR'OR tblReceiveTemp.SprintReceiveStatus = 'NR' OR tblReceiveTemp.VerizonReceiveStatus = 'NR'"
Set rst = db.OpenRecordset(strSql, dbOpenDynaset)
'If recordset is empty, exit
Do While Not rst.EOF
distro = distro & ";" & rst.Fields("[Level 1Approver Email]")
  
rst.MoveNext
Loop
With oOMail_001
'now use the variable disto with all the email names in the to field of outlook
'.CC =
.BCC = distro
.Subject = "ATT, Sprint and Verizon Wireless Telecommunication Approval - Reminder 2"
.Body = "Body"
.display
.BodyFormat = 1
End With
rst.Close
Set rst = Nothing
Set db = Nothing
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryATTEmailUpdate3"
DoCmd.OpenQuery "qrySprintEmailUpdate3"
DoCmd.OpenQuery "qryVerizonEmailUpdate3"
DoCmd.SetWarnings True

End Sub


Private Sub cmdEmailConfirmed3_Click()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim oOApp_001 As Outlook.Application
Dim oOMail_001 As Outlook.MailItem
Dim distro As String
Dim strSql As String
Set db = CurrentDb()
'Sets the email distro and subject line to blank
distro = ""
Set oOApp_001 = CreateObject("Outlook.Application")
Set oOMail_001 = oOApp_001.CreateItem(olMailItem)

strSql = "SELECT tblReceiveTemp.ATTReceiveStatus, tblReceiveTemp.SprintReceiveStatus, tblReceiveTemp.VerizonReceiveStatus, tblReceiveTemp.[Level 1Approver Email], tblReceiveTemp.[Level 1Approver]" & _
" FROM tblReceiveTemp " & _
" WHERE tblReceiveTemp.ATTReceiveStatus = 'NR'OR tblReceiveTemp.SprintReceiveStatus = 'NR' OR tblReceiveTemp.VerizonReceiveStatus = 'NR'"
Set rst = db.OpenRecordset(strSql, dbOpenDynaset)
'If recordset is empty, exit
Do While Not rst.EOF
distro = distro & ";" & rst.Fields("[Level 1Approver Email]")
  
rst.MoveNext
Loop
With oOMail_001
'now use the variable disto with all the email names in the to field of outlook
'.CC =
.BCC = distro
.Subject = "ATT, Sprint and Verizon Wireless Telecommunication Approval - Reminder 3"
Body = "Body"
.display
.BodyFormat = 1
End With
rst.Close
Set rst = Nothing
Set db = Nothing
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryATTEmailUpdate4"
DoCmd.OpenQuery "qrySprintEmailUpdate4"
DoCmd.OpenQuery "qryVerizonEmailUpdate4"
DoCmd.SetWarnings True
End Sub
Private Sub cmdEmailConfirmedUSA_Click()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim oOApp_001 As Outlook.Application
Dim oOMail_001 As Outlook.MailItem
Dim distro As String
Dim strSql As String
Set db = CurrentDb()
'Sets the email distro and subject line to blank
distro = ""
Set oOApp_001 = CreateObject("Outlook.Application")
Set oOMail_001 = oOApp_001.CreateItem(olMailItem)

strSql = "SELECT tblReceiveTemp.USAReceiveStatus,tblReceiveTemp.[Level 1Approver Email], tblReceiveTemp.[Level 1Approver]" & _
" FROM tblReceiveTemp " & _
" WHERE tblReceiveTemp.USAReceiveStatus = 'NR'"
Set rst = db.OpenRecordset(strSql, dbOpenDynaset)
'If recordset is empty, exit
Do While Not rst.EOF
distro = distro & ";" & rst.Fields("[Level 1Approver Email]")
  
rst.MoveNext
Loop
With oOMail_001
'now use the variable disto with all the email names in the to field of outlook
'.CC =
.BCC = distro
.Subject = "USA Mobility Wireless Telecommunication Approval - Reminder 1"
.Body = "Body"
.display
.BodyFormat = 1
End With
rst.Close
Set rst = Nothing
Set db = Nothing
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryUSAEmailUpdate2"
DoCmd.SetWarnings True
End Sub
Private Sub cmdEmailConfirmedUSA2_Click()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim oOApp_001 As Outlook.Application
Dim oOMail_001 As Outlook.MailItem
Dim distro As String
Dim strSql As String
Set db = CurrentDb()
'Sets the email distro and subject line to blank
distro = ""
Set oOApp_001 = CreateObject("Outlook.Application")
Set oOMail_001 = oOApp_001.CreateItem(olMailItem)

strSql = "SELECT tblReceiveTemp.USAReceiveStatus,tblReceiveTemp.[Level 1Approver Email], tblReceiveTemp.[Level 1Approver]" & _
" FROM tblReceiveTemp " & _
" WHERE tblReceiveTemp.USAReceiveStatus = 'NR'"
Set rst = db.OpenRecordset(strSql, dbOpenDynaset)
'If recordset is empty, exit
Do While Not rst.EOF
distro = distro & ";" & rst.Fields("[Level 1Approver Email]")
  
rst.MoveNext
Loop
With oOMail_001
'now use the variable disto with all the email names in the to field of outlook
'.CC =
.BCC = distro
.Subject = "ATT, Sprint and Verizon Wireless Telecommunication Approval - Reminder 1"
.Body = "Body"
.display
.BodyFormat = 1
End With
rst.Close
Set rst = Nothing
Set db = Nothing
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryUSAEmailUpdate3"
DoCmd.SetWarnings True
End Sub
Private Sub cmdEmailConfirmedUSA3_Click()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim oOApp_001 As Outlook.Application
Dim oOMail_001 As Outlook.MailItem
Dim distro As String
Dim strSql As String
Set db = CurrentDb()
'Sets the email distro and subject line to blank
distro = ""
Set oOApp_001 = CreateObject("Outlook.Application")
Set oOMail_001 = oOApp_001.CreateItem(olMailItem)

strSql = "SELECT tblReceiveTemp.USAReceiveStatus,tblReceiveTemp.[Level 1Approver Email], tblReceiveTemp.[Level 1Approver]" & _
" FROM tblReceiveTemp " & _
" WHERE tblReceiveTemp.USAReceiveStatus = 'NR'"
Set rst = db.OpenRecordset(strSql, dbOpenDynaset)
'If recordset is empty, exit
Do While Not rst.EOF
distro = distro & ";" & rst.Fields("[Level 1Approver Email]")
  
rst.MoveNext
Loop
With oOMail_001
'now use the variable disto with all the email names in the to field of outlook
'.CC =
.BCC = distro
.Subject = "ATT, Sprint and Verizon Wireless Telecommunication Approval - Reminder 1"
.Body = "Body"
.display
.BodyFormat = 1
End With
rst.Close
Set rst = Nothing
Set db = Nothing
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryUSAEmailUpdate4"
DoCmd.SetWarnings True
End Sub


To add to a menu, create a command button from the "Design Tab", right click on the command button that was just placed on the form, and go the the event tab. On the "on click" click on the "..." and paste the code that you want to use.
 
Last edited by a moderator:

lucy1216

Registered User.
Local time
Today, 13:43
Joined
Feb 28, 2013
Messages
11
This may assist you as well:

Google the following:
Sending Google Mail (Gmail) from MS Access, VBA, Excel, Word...by Tony Hine
 

Users who are viewing this thread

Top Bottom