VBA report to generate pdf and email (1 Viewer)

jamescullis · Jan 21, 2015

hi All, newbie needing some help please?

I found the vba to generate multiple pdf's from a single report which is working well (see below).

The script below generates about 15 pdf files and stores them in the specified directory

I'd like to be able to now email these to the individual users (SCNAME) but cannot work out where to start, i've tried a lot of things from the research on emailing, just not working.

All the information I need is in one table which includes the users email address field (SCemail).

I've also created an update query which generates a unique file name into the field (SCInstallDate) (currently not using this field data)

Can you please advise how to modify the below code to make this happen, or should I be creating another process to look for the email address and file name

Code:

Private Sub cmdSC2PDF_Click()
Dim rst As DAO.Recordset

Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [SCNAME] FROM [Schedule];", dbOpenSnapshot)

Do While Not rst.EOF
    strRptFilter = "[SCName] = " & Chr(34) & rst![SCNAME] & Chr(34)
    DoCmd.OutputTo acOutputReport, "fullschedulereport", acFormatPDF, "\\Server001\CompanyData\SC\temp" & "\" & rst![SCNAME] & "-" & Format(Date, "dd-mm-yyyy") & ".pdf"
    DoEvents
    rst.MoveNext
Loop

rst.Close
Set rst = Nothing
End Sub

thanks in advance

GinaWhipp · Jan 21, 2015

Perhaps this will help...
http://www.access-diva.com/vba16.html

jamescullis · Jan 22, 2015

that worked almost, thank you.

What it doesn't do is create individual emails like the previous code I provided which splits the main report into a single user report and saves to a directory.

Below is the code you gave me the link to which is creating one email and one report, it puts all email addresses in the TO column.

can you advise where I've gone wrong?

Code:

Private Sub cmdSCEmail_Click()
     Dim rs As Recordset
     Dim vRecipientList As String
     Dim vMsg As String
     Dim vSubject As String

          Set rs = CurrentDb.OpenRecordset("SELECT * FROM subbies")
          If rs.RecordCount > 0 Then
              rs.MoveFirst
              Do
                  If Not IsNull(rs!SubbieEmail) Then
                      vRecipientList = vRecipientList & rs!SubbieEmail & ";"
                      rs.MoveNext
                 Else
                      rs.MoveNext
                 End If

             Loop Until rs.EOF

             vMsg = " Your Message here... "
             vSubject = " Your Subject here... "

             DoCmd.SendObject acSendReport, "fullschedulereport", acFormatPDF, vRecipientList, , , vSubject, vMsg, False
             MsgBox ("Report successfully eMailed!")

     Else
             MsgBox "No contacts."
     End If

End Sub

GinaWhipp · Jan 22, 2015

Oh, I was thinking you would incorporate your code within that code. The one I have was not done to create separate eMails just send the same to each person, one of the limitations with DoCmd.SendObject. My fault for missing that!

You are going to have to use Automation...

Code:

 Function Email(strTo As String, strSubject _
        As String, Optional varMsg As Variant, Optional varAttachment As Variant)
 ' ©Arvin Meyer 1999-2004 
' Permission to use is granted if copyright notice is left intact.
' Permisssion is denied for use with unsolicited commercial email
 'Set reference to Outlook
On Error GoTo Errhandler
Dim strBCC As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim objOutl As Outlook.Application
'Dim objEml As Outlook.MailItem
Dim I As Integer
 Set db = CurrentDb
Set rst = db.OpenRecordset("qryContacts", dbOpenSnapshot)
 Set objOutl = CreateObject("Outlook.application")
'Set objEml = objOutl.createItem(olMailitem)
 With rst
    If .RecordCount > 0 Then
        .MoveLast
        .MoveFirst
    End If
End With
 For I = 1 To rst.RecordCount
    If Len(rst!EmailAddress) > 0 Then
        strTo = rst!EmailAddress
    Dim objEml As Outlook.MailItem
    Set objEml = objOutl.createItem(olMailitem)
         With objEml
            .To = strTo
             .Subject = strSubject
            
            If Not IsNull(varMsg) Then
                .Body = varMsg
            End If
 ' Uncomment for attachment            
'            If Not IsMissing(varAttachment) Then
'                .Attachments.Add varAttachment
'            End If
            
            .Send
        End With
    End If
    Set objEml = Nothing
    rst.MoveNext
Next I
 ExitHere:
Set objOutl = Nothing
'Set objEml = Nothing
Set rst = Nothing
Set db = Nothing
     Exit Function
    
Errhandler:
    MsgBox Err.Number & ": " & Err.Description
    Resume ExitHere
 End Function

jamescullis · Jan 22, 2015

not a problem Gina, I really appreciate your assistance.

It made me think about it, no just copy and paste

I'll give your new code a try tonight.

thanks again.

jamescullis · Jan 22, 2015

ok, I'm stumped

my homework hasn't worked, I've play around with this and a couple of other snippets found, I sort of get it but just can't work it out. I've read that I can't call that function from within the Private Sub.

not sure where to start now!

Minty · Jan 22, 2015

How are you trying to call it - please post the code?

GinaWhipp · Jan 22, 2015

Hmm, it can't go in a Private Function, you need to post the code in a Module and not the Forms Module. Once you have done that post what you have so I can take a look.

jamescullis · Jan 24, 2015

I've added the "Automation" function to a module.

My problem is not knowing where to call the module "Email" from within Private Sub. I presume I have to replace the "DoCmd.SendObject" part, just not sure at all on how to do this. I'm probably barking up the wrong tree....

Code:

Private Sub cmdSCEmail_Click()
     Dim rs As Recordset
     Dim vRecipientList As String
     Dim vMsg As String
     Dim vSubject As String

          Set rs = CurrentDb.OpenRecordset("SELECT * FROM subbies")
          If rs.RecordCount > 0 Then
              rs.MoveFirst
              Do
                  If Not IsNull(rs!SubbieEmail) Then
                      vRecipientList = vRecipientList & rs!SubbieEmail & ";"
                      rs.MoveNext
                 Else
                      rs.MoveNext
                 End If

             Loop Until rs.EOF

             vMsg = " Your Message here... "
             vSubject = " Your Subject here... "

             [COLOR="Red"]DoCmd.SendObject acSendReport, "fullschedulereport", acFormatPDF, vRecipientList, , , vSubject, vMsg, False
             MsgBox ("Report successfully eMailed!")[/COLOR]

     Else
             MsgBox "No contacts."
     End If

End Sub

jamescullis · Jan 24, 2015

I've attached the DB which may show you what the hell I'm trying to do

the form that generates the PDF and where I'm trying to email from is on the switchboard "Generate PDF Reports"

There are a couple of buttons on there.

1. Print Subbie Runs (Command5) (this works in generating the pdf's, now I want to send them to each Subbie, individually)
2. trying to email (cmdSCEmail) (this is my test button)

note - sorry for the poor naming conventions in advance.

GinaWhipp · Jan 24, 2015

Umm, have you ever worked with Modules before? Because you did not change the Recordset in Module to match yours. You need to do that first... Then you are trying to combine the DoCmd.SendObject with the Module and you can't they are two separate things.

So, fix the Module to match your Recordset and then re-upload.

Side note, those tables looks poorly normalized and this will cause you additional problems down the road. You might want to consider fixing that now while it's still early.

jamescullis · Jan 24, 2015

Thanks Gina, I'll work on that. As mentioned in first post, I'm a newbie to this.

GinaWhipp · Jan 25, 2015

Oh, even better to learn by

... so, look at the Module and replace the Recordset and the field names and then post back with what you have.

jamescullis · Feb 1, 2015

Hi Gina, just letting you know I'm in the process of writing this from the ground up. Hopefully this will help learn this.

GinaWhipp · Feb 1, 2015

No problem... will be here when you get stuck! Hmm, I should say IF you get stuck!

VBA report to generate pdf and email (1 Viewer)

jamescullis

Registered User.

GinaWhipp

AWF VIP

jamescullis

Registered User.

GinaWhipp

AWF VIP

jamescullis

Registered User.

jamescullis

Registered User.

Minty

AWF VIP

GinaWhipp

AWF VIP

jamescullis

Registered User.

jamescullis

Registered User.

Attachments

GinaWhipp

AWF VIP

jamescullis

Registered User.

GinaWhipp

AWF VIP

jamescullis

Registered User.

GinaWhipp

AWF VIP

Similar threads

Users who are viewing this thread