MSAccess, Print each Report as pdf with different file name and email

X

xdenama

Registered User.
Local time
Today, 11:58
Joined
Dec 4, 2015
Messages
26
I have a code for email the whole report to the one recipient. How to print the report separately by customer id with pdf format and email them to related customer?
Code: 
Private Sub Command0_Click()

On Error GoTo Err_Handler
Dim oApp As New Outlook.Application
Dim oEmail As Outlook.MailItem
Dim fileName As String, todayDate As String

'Export report in same folder as db with date stamp
todayDate = Format(Date, "MMDDYYYY")
fileName = Application.CurrentProject.Path & "\Goodies_" & todayDate & ".pdf"
DoCmd.OutputTo acReport, "MYreport", acFormatPDF, fileName, False

'Email the results of the report generated
Set oEmail = oApp.CreateItem(olMailItem)
With oEmail
    .Recipients.Add "myemail@gmail.com"
    .Subject = "Free Gift"
    .Body = "With Compliment"
    .Attachments.Add fileName
    .Send
End With

MsgBox "Email successfully sent!", vbInformation, "EMAIL STATUS"


End Sub
 
I answered a similar question a while back. I blogged about it on my website here:-

Generate Multiple Reports
www.niftyaccess.com

Generate Multiple Reports - Nifty Access

Generate Multiple Reports This blog came about because of an answer I gave to a particular OP's question. Therefore the code isn't generic, it is designed for a specific situation, like most examples! However I hope there's enough information here for you to follow what's happening. Multiple...
www.niftyaccess.com www.niftyaccess.com
 
The downloads are available for free, contact me for details on how to get free copies...
 
Uncle Gizmo said:
I answered a similar question a while back. I blogged about it on my website here:-

Generate Multiple Reports
www.niftyaccess.com

Generate Multiple Reports - Nifty Access

Generate Multiple Reports This blog came about because of an answer I gave to a particular OP's question. Therefore the code isn't generic, it is designed for a specific situation, like most examples! However I hope there's enough information here for you to follow what's happening. Multiple...
www.niftyaccess.com www.niftyaccess.com
Click to expand...
Wow, so impressive. This is what I've been looking for. However if I've any more inquiries , can you consult me?
 
if you have customer table, add it to the code:
Code: 
Private Sub Command0_Click()

On Error GoTo Err_Handler
Dim oApp As New Outlook.Application
Dim oEmail As Outlook.MailItem
Dim fileName As String, todayDate As String

Const YourCustomerTable As String = "[tblCustomer]"
Const TheEmailField As String = "[e-mail]"
Dim dbs As DAO.Database
Dim rst As DAO.Recordset

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(YourCustomerTable, dbOpenSnapshot, dbReadOnly)
With rst
    If Not (.BOF And .EOF) Then
        .MoveFirst
    End If
    Do Until .EOF
        'Export report in same folder as db with date stamp
        todayDate = Format(Date, "MMDDYYYY")
        'add the ID to the filename
        fileName = Application.CurrentProject.Path & "\Goodies_" & !ID & todayDate & ".pdf"
        'erase the file if already exists
        If Len(Dir(fileName)) > 0 Then Kill fileName
        'open the report hidden, in design mode
        DoCmd.OpenReport ReportName:="MYreport", WhereCondition:="ID = " & !ID, View:=acViewDesign, WindowMode:=acHidden
        
        DoCmd.OutputTo acReport, "MYreport", acFormatPDF, fileName, False
        
        'wait until the pdf is produced.
        Do Until Len(Dir(fileName)) > 0
            DoEvents
        Loop
        Do Until VBA.FileLen(fileName) > 0
            DoEvents
        Loop
        'close the report
        DoCmd.Close acReport, "Myreport", acSaveNo
        
        'Email the results of the report generated
        Set oEmail = oApp.CreateItem(olMailItem)
        With oEmail
            .Recipients.Add rst.Fields(TheEmailField)
            .Subject = "Free Gift"
            .Body = "With Compliment"
            .Attachments.Add fileName
            .Send
        End With
        .MoveNext
    Loop
    .Close
End With

Set rst = Nothing
Set dbs = Nothing
MsgBox "Email successfully sent!", vbInformation, "EMAIL STATUS"


End Sub
 
@arnelgp what is the following for?

Code: 
    Do Until VBA.FileLen(fileName) > 0
        DoEvents
    Loop

Thanks.
 
Code: 
Private Sub Command7_Click()


'On Error GoTo Err_Handler
Dim oApp As New Outlook.Application
Dim oEmail As Outlook.MailItem
Dim fileName As String, todayDate As String

Const YourCustomerTable As String = "[Test3]"
Const TheEmailField As String = "[Email]"
Dim dbs As DAO.Database
Dim rst As DAO.Recordset

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(YourCustomerTable, dbOpenSnapshot, dbReadOnly)
With rst
    If Not (.BOF And .EOF) Then
        .MoveFirst
    End If
    Do Until .EOF
        'Export report in same folder as db with date stamp
        todayDate = Format(Date, "MMDDYYYY")
        'add the ID to the filename
        fileName = Application.CurrentProject.Path & "\Goodies_" & !ID & todayDate & ".pdf"
        'erase the file if already exists
        If Len(Dir(fileName)) > 0 Then Kill fileName
        'open the report hidden, in design mode
        DoCmd.OpenReport ReportName:="Test2", WhereCondition:="ID = " & !ID, View:=acViewDesign, WindowMode:=acHidden
        
        DoCmd.OutputTo acReport, "Test2", acFormatPDF, fileName, False
        
        'wait until the pdf is produced.
        Do Until Len(Dir(fileName)) > 0
            DoEvents
        Loop
        Do Until VBA.FileLen(fileName) > 0
            DoEvents
        Loop
        'close the report
        DoCmd.Close acReport, "Test2", acSaveNo
        
        'Email the results of the report generated
        Set oEmail = oApp.CreateItem(olMailItem)
        With oEmail
            .Recipients.Add rst.Fields(TheEmailField)
            .Subject = "Free Gift"
            .Body = "With Compliment"
            .Attachments.Add fileName
            .Send
        End With
        .MoveNext
    Loop
    .Close
End With

Set rst = Nothing
Set dbs = Nothing
MsgBox "Email successfully sent!", vbInformation, "EMAIL STATUS"


End Sub

My table is Test3, my report is Test2, my email column is Email. But error,
...."the microsoft access database engine cannot find the input table or query '[Test3]'...
 
arnelgp said:
if you have customer table, add it to the code:
Code: 
Private Sub Command0_Click()

On Error GoTo Err_Handler
Dim oApp As New Outlook.Application
Dim oEmail As Outlook.MailItem
Dim fileName As String, todayDate As String

Const YourCustomerTable As String = "[tblCustomer]"
Const TheEmailField As String = "[e-mail]"
Dim dbs As DAO.Database
Dim rst As DAO.Recordset

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(YourCustomerTable, dbOpenSnapshot, dbReadOnly)
With rst
    If Not (.BOF And .EOF) Then
        .MoveFirst
    End If
    Do Until .EOF
        'Export report in same folder as db with date stamp
        todayDate = Format(Date, "MMDDYYYY")
        'add the ID to the filename
        fileName = Application.CurrentProject.Path & "\Goodies_" & !ID & todayDate & ".pdf"
        'erase the file if already exists
        If Len(Dir(fileName)) > 0 Then Kill fileName
        'open the report hidden, in design mode
        DoCmd.OpenReport ReportName:="MYreport", WhereCondition:="ID = " & !ID, View:=acViewDesign, WindowMode:=acHidden
       
        DoCmd.OutputTo acReport, "MYreport", acFormatPDF, fileName, False
       
        'wait until the pdf is produced.
        Do Until Len(Dir(fileName)) > 0
            DoEvents
        Loop
        Do Until VBA.FileLen(fileName) > 0
            DoEvents
        Loop
        'close the report
        DoCmd.Close acReport, "Myreport", acSaveNo
       
        'Email the results of the report generated
        Set oEmail = oApp.CreateItem(olMailItem)
        With oEmail
            .Recipients.Add rst.Fields(TheEmailField)
            .Subject = "Free Gift"
            .Body = "With Compliment"
            .Attachments.Add fileName
            .Send
        End With
        .MoveNext
    Loop
    .Close
End With

Set rst = Nothing
Set dbs = Nothing
MsgBox "Email successfully sent!", vbInformation, "EMAIL STATUS"


End Sub
Click to expand...
I post new code with error
 
xdenama said:
if I've any more inquiries , can you consult me?
Click to expand...
Certainly. Watch the videos, when you get to a bit that isn't clear, send me a time indexed link to the place in the video, and explain what is not clear....
 
remove the square parenthesis and change:

Const TheEmailField As String = "[e-mail]"

To:

Const TheEmailField As String = "e-mail"
 
Sun_Force, it is for safety, we do not want the Close the Report prematurely.
we need to wait until a .pdf is produced (not zero length pdf).
 
arnelgp said:
remove the square parenthesis and change:

Const TheEmailField As String = "[e-mail]"

To:

Const TheEmailField As String = "e-mail"
Click to expand...
It's working, save as pdf with different file name and email, but each pdf contain all report, not separate.
maybe this line
Code: 
DoCmd.OutputTo acReport, "Test2", acFormatPDF, fileName, False
 
change:

View:=acViewDesign


To:

View:=acViewPreview
 
xdenama said:
Still not change, and every recipient received the email repeatedly as a numbers of email.
Click to expand...
Sorry, it's working. Maybe I received last email is delayed email and I assume that is a current email. Thanks
 
I post the correct code to others for future reference.

Code: 
Private Sub Command0_Click()

On Error GoTo Err_Handler
Dim oApp As New Outlook.Application
Dim oEmail As Outlook.MailItem
Dim fileName As String, todayDate As String

Const YourCustomerTable As String = "tblCustomer"
Const TheEmailField As String = "[e-mail]"
Dim dbs As DAO.Database
Dim rst As DAO.Recordset

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(YourCustomerTable, dbOpenSnapshot, dbReadOnly)
With rst
    If Not (.BOF And .EOF) Then
        .MoveFirst
    End If
    Do Until .EOF
        'Export report in same folder as db with date stamp
        todayDate = Format(Date, "MMDDYYYY")
        'add the ID to the filename
        fileName = Application.CurrentProject.Path & "\Goodies_" & !ID & todayDate & ".pdf"
        'erase the file if already exists
        If Len(Dir(fileName)) > 0 Then Kill fileName
        'open the report hidden, in design mode
        DoCmd.OpenReport ReportName:="MYreport", WhereCondition:="ID = " & !ID, View:=acViewPreview, WindowMode:=acHidden
        
        DoCmd.OutputTo acReport, "MYreport", acFormatPDF, fileName, False
        
        'wait until the pdf is produced.
        Do Until Len(Dir(fileName)) > 0
            DoEvents
        Loop
        Do Until VBA.FileLen(fileName) > 0
            DoEvents
        Loop
        'close the report
        DoCmd.Close acReport, "Myreport", acSaveNo
        
        'Email the results of the report generated
        Set oEmail = oApp.CreateItem(olMailItem)
        With oEmail
            .Recipients.Add rst.Fields(TheEmailField)
            .Subject = "Free Gift"
            .Body = "With Compliment"
            .Attachments.Add fileName
            .Send
        End With
        .MoveNext
    Loop
    .Close
End With

Set rst = Nothing
Set dbs = Nothing
MsgBox "Email successfully sent!", vbInformation, "EMAIL STATUS"


End Sub
 
arnelgp said:
Sun_Force, it is for safety, we do not want the Close the Report prematurely.
we need to wait until a .pdf is produced (not zero length pdf).
Click to expand...
Sorry, still can't understand. You have two loops. Doesn't the first loop do the same?
What's the difference between the first and the second?

SQL: 
'wait until the pdf is produced.
Do Until Len(Dir(fileName)) > 0
    DoEvents
Loop

Do Until VBA.FileLen(fileName) > 0
    DoEvents
Loop

Thanks again.
 
the first check for the Existence of the file.
the second the length of the file.
 
arnelgp said:
the first check for the Existence of the file.
the second the length of the file.
Click to expand...
I've one problem here. Lets say, If first batch of email I send to 10 recipient then the second batch I only send to 8 recipient, the two file that created for the first batch also send for the second time...
 
the pdf is based on ID (autonumber i supposed) which is unique on each batch.
unless IDs in batch 1 is same on batch 2.
 
You must log in or register to reply here.

Similar threads

P
Create seperate PDF Files from a report Base on a query with more than 300 records
Replies
5
Views
965
Uncle Gizmo
Uncle Gizmo
C
Invalid Use of Null
2
Replies
20
Views
1,451
chuckcoleman
C
M
Multiple attachments and a report in the same email
Replies
15
Views
1,527
Marshall Brooks
M
M
VBA output report to PDF and email
Replies
18
Views
1,590
Pat Hartman
P
R
Solved Print Report As PDF file
Replies
5
Views
1,340
Rania01
R

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom