MSAccess, Print each Report as pdf with different file name and email (1 Viewer)

xdenama

Registered User.
Local time
Yesterday, 22:39
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
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 06:39
Joined
Jul 9, 2003
Messages
12,094
I answered a similar question a while back. I blogged about it on my website here:-

Generate Multiple Reports
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 06:39
Joined
Jul 9, 2003
Messages
12,094
The downloads are available for free, contact me for details on how to get free copies...
 

xdenama

Registered User.
Local time
Yesterday, 22:39
Joined
Dec 4, 2015
Messages
26
I answered a similar question a while back. I blogged about it on my website here:-

Generate Multiple Reports
Wow, so impressive. This is what I've been looking for. However if I've any more inquiries , can you consult me?
 

arnelgp

error reading drive A:
Local time
Today, 14:39
Joined
May 7, 2009
Messages
10,842
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
 

Sun_Force

Member
Local time
Today, 15:39
Joined
Aug 29, 2020
Messages
67
@arnelgp what is the following for?

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

Thanks.
 

xdenama

Registered User.
Local time
Yesterday, 22:39
Joined
Dec 4, 2015
Messages
26
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]'...
 

xdenama

Registered User.
Local time
Yesterday, 22:39
Joined
Dec 4, 2015
Messages
26
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
I post new code with error
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 06:39
Joined
Jul 9, 2003
Messages
12,094
if I've any more inquiries , can you consult me?
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....
 

arnelgp

error reading drive A:
Local time
Today, 14:39
Joined
May 7, 2009
Messages
10,842
remove the square parenthesis and change:

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

To:

Const TheEmailField As String = "e-mail"
 

arnelgp

error reading drive A:
Local time
Today, 14:39
Joined
May 7, 2009
Messages
10,842
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).
 

xdenama

Registered User.
Local time
Yesterday, 22:39
Joined
Dec 4, 2015
Messages
26
remove the square parenthesis and change:

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

To:

Const TheEmailField As String = "e-mail"
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
 

arnelgp

error reading drive A:
Local time
Today, 14:39
Joined
May 7, 2009
Messages
10,842
change:

View:=acViewDesign


To:

View:=acViewPreview
 

xdenama

Registered User.
Local time
Yesterday, 22:39
Joined
Dec 4, 2015
Messages
26
Still not change, and every recipient received the email repeatedly as a numbers of email.
Sorry, it's working. Maybe I received last email is delayed email and I assume that is a current email. Thanks
 

xdenama

Registered User.
Local time
Yesterday, 22:39
Joined
Dec 4, 2015
Messages
26
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
 

Sun_Force

Member
Local time
Today, 15:39
Joined
Aug 29, 2020
Messages
67
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).
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.
 

arnelgp

error reading drive A:
Local time
Today, 14:39
Joined
May 7, 2009
Messages
10,842
the first check for the Existence of the file.
the second the length of the file.
 

xdenama

Registered User.
Local time
Yesterday, 22:39
Joined
Dec 4, 2015
Messages
26
the first check for the Existence of the file.
the second the length of the file.
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...
 

arnelgp

error reading drive A:
Local time
Today, 14:39
Joined
May 7, 2009
Messages
10,842
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.
 

Users who are viewing this thread

Top Bottom