Form data, create PDF(s) and e-mail

[Bar_NZ]

Hi All, wondering if you could assist me please.

I have a table created from a query which contains member names and e-mail addresses and fee they have to pay. There are currently 995 records in this table.

Each member has a MemberNumber (Fieldname) which is unique, but not sequential.

What I need to do is...
1 Click a button to export each record with its information and formatting to a PDF with the MemberNumber and Surname as the document name to a folder in my T:\

2 Get the email address where the member number is the same, attach the file for that record and email it to the member.

I have managed to do the export to file, however it loops and prints (to PDF) 995 times, so takes a very long time for it to process each record.

So in a nut shell, create the PDF for each record and email it to the correct person.

 

[Ranman256]

in a form is a listbox
the list is a query of the name to send to
this cycles thru the list, collects the names, then sends the report
text boxes hold the report name, email body, and subject

sub btnSend_click()
dim vTo
dim i as integer

for i = 0 to lstBox.listcount -1
    vTo = lstBox.itemdata(i)    'get next email in listbox
    lstBox = vTo		'set the listbox to this item

       'email the rpt
   docmd.SendObject acSendReport ,txtReport,acFormatPDF, vTo,,,txtSubj,txtBody
  
        'save the report
    vFile = "t:\folder\" & vTo & ".pdf"
    docmd.OutputTo acOutputReport ,"rMyReport",acFormatPDF,vFile 
next
end 
end sub

 

[Bar_NZ]

OK, so maybe I don't have the exporting to PDF sorted, I get 995 separate PDF files, each contain all records....

Private Sub Command6_Click()
    Dim sReportName As String
    Dim sCriteria As String
    sReportName = "Subs" '' name of the predefined report
    
    Dim rs As Recordset
    Set rs = Me.Recordset
    rs.MoveFirst
    
    Do While Not rs.EOF
    sCriteria = "[MemberNumber]=" & rs.Fields("MemberNumber").Value
    
    '' DoCmd.OpenReport sReportName, acViewNormal, , sCriteria
    DoCmd.OutputTo acOutputReport, sReportName, acFormatPDF, "T:\BCE_Subs_export\" & rs.Fields("MemberNumber") & ".PDF", False
    '' DoCmd.Close acReport, sReportName
    
    rs.MoveNext
    Loop
    
   
End Sub

 

[pbaldy]

The open and close report lines you have commented out should be left in. The OutputTo command will export the filtered report if it's open. You can open it hidden to eliminate flickering if it's an issue.

Say hi to my daughter for me (lives across the bay from you).

 

[Bar_NZ]

Yeah the flickering not so much of an issue at this point, but each PDF output contains all records, they should only contain the relevant record for that member. I have tested again with commented out line un-commented out and same result. I can't upload a sample as it's to big, lol

What part of WGTN does she live?

 

[pbaldy]

Oh, just noticed acViewNormal should be acViewPreview so the report stays open for the OutputTo line. I assume it's printing now?

Daughter lives in Eastbourne now. My wife and I have visited 3 times so far. Beautiful country you have there!

 

[Bar_NZ]

Well, that works perfect now! Thanks.

Just need to figure out the, click a button, to Create an email to that specific member and attach the correct invoice that was just created....

Knowing that my test data included only 9 e-mail addresses but the real tables have 995 records, lol.

My brother lives in Eastbourne, he loves it over there. How long has she been living in NZ for?

 

[pbaldy]

No problem. Do you need the files saved? If not you can use SendObject instead of OutputTo. If you do need them, you can use Outlook automation or CDO to create an email and add the attachment just created.

They've been there 6 or 7 years now I think. They love it there.

 

[Bar_NZ]

I have managed to save the files, to a network drive T:\BCE-Subs_Export, they are named with the members ID (1234.PDF).

So, What I need to do is for each one, create a separate e-mail and then attach the previously created Subs PDF that is equal to their MemberNumber. So If there is a file called 1234.pdf, and their member number is 1234, then create an email for them, and attach that file, then move onto the next record and do the same. There are curently about 900 odd members in this table, however I'm testing with 10 fake names and number, but real e-mail addresses.

She has been in WGTN about the same time I have, we moved up from Christchurch about that time...

 

[Bar_NZ]

Code used to create the files

Private Sub Command6_Click()
    Dim sReportName As String
    Dim sCriteria As String
    sReportName = "Subs" '' name of the predefined report
    
    Dim rs As Recordset
    Set rs = Me.Recordset
    rs.MoveFirst
    
    Do While Not rs.EOF
    sCriteria = "[MemberNumber]=" & rs.Fields("MemberNumber").Value
    
    DoCmd.OpenReport sReportName, acViewPreview, , sCriteria
    DoCmd.OutputTo acOutputReport, sReportName, acFormatPDF, "T:\BCE_Subs_export\" & rs.Fields("MemberNumber") & ".PDF", False
    DoCmd.Close acReport, sReportName
    
    rs.MoveNext
    Loop
End Sub

 

[pbaldy]

Do you use Outlook? If so, you can use Outlook automation to create the emails. Here's a start:

https://support.microsoft.com/en-us...send-a-microsoft-outlook-message-using-access

 

[Bar_NZ]

OK, I'm back now and have made some progress, also revisited an older thread we had discussion in.

So i can create the email and send, but what I cant seem to do is....
1: Have it create a separate email for each recipient
2: Have it attach the subs invoice, ensuring its the right invoice for the right person being emailed.

Private Sub Command18_Click()
Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim MyBodyText As String
Dim rsemail As DAO.Recordset
Dim ns As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Dim mysql As String
Subjectline$ = "Yearly Subs Invoice"
DoCmd.SetWarnings False
Set MyOutlook = New Outlook.Application
Set MyOutlook = CreateObject("Outlook.Application")
Set ns = MyOutlook.GetNamespace("MAPI")
Set Folder = ns.GetDefaultFolder(olFolderInbox)
MyOutlook.Explorers.Add Folder
Set rsemail = CurrentDb.OpenRecordset("eMail")
Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.SentOnBehalfOfName = "Do_Not_Reply@nzrwelfare.co.nz"
Do Until rsemail.EOF

MyMail.To = MyMail.To & rsemail!EmailAddress & ";"

'And on to the next one...
rsemail.MoveNext

Loop
'This gives it a subject
MyMail.Subject = Subjectline$
MyMail.Body = "Hello," & Chr(13) & Chr(13) & "Please find attached the invoice for you yearly subs." & Chr(13) & Chr(13) & "Thank you from the Team"
MyMail.Display
Set MyMail = Nothing
Set MyOutlook = Nothing
DoCmd.SetWarnings True
rsemail.Close
db.Close
Set db = Nothing
End Sub

Any ideas on this please?

 

[Bar_NZ]

Updated to include specific info in body and subject line.

Private Sub Command18_Click()
Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim MyBodyText As String
Dim rsemail As DAO.Recordset
Dim ns As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Dim mysql As String
Subjectline$ = Me.Surname & " " & Me.MemberNumber & " " & "Group" & " " & Me.Group & " " & "Subs Invoice"
DoCmd.SetWarnings False
Set MyOutlook = New Outlook.Application
Set MyOutlook = CreateObject("Outlook.Application")
Set ns = MyOutlook.GetNamespace("MAPI")
Set Folder = ns.GetDefaultFolder(olFolderInbox)
MyOutlook.Explorers.Add Folder
Set rsemail = CurrentDb.OpenRecordset("Group_BCE_Email_Subs")
Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.SentOnBehalfOfName = "Do_Not_Reply@nzrwelfare.co.nz"
Do Until rsemail.EOF

MyMail.To = MyMail.To & ";" & rsemail!EmailAddress

'And on to the next one...
rsemail.MoveNext

Loop
'This gives it a subject
MyMail.Subject = Subjectline$
MyMail.Body = "Hi" & " " & Me.PreferredFirst & Chr(13) & Chr(13) & "Please find attached your group" & " " & Me.Group & " " & "membership invoice." & Chr(13) & Chr(13) & "Thank you from your Welfare team" & Chr(13) & Chr(13) & "Don't forget to like us on Facebook at NZ Railways Staff Welfare Trust"
MyMail.Display
Set MyMail = Nothing
Set MyOutlook = Nothing
DoCmd.SetWarnings True
rsemail.Close
'db.Close
Set db = Nothing
End Sub

 

[Bar_NZ]

OK, change of tack, re-written the code with some google assistance. My last item to achieve is to have it send from a specific e-mail account, not my default account.

Commented out line, does not seem to function, any ideas please?

Private Sub Command18_Click()
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim objOutlook As Object
Dim Attach As String
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset("Group_BCE_Email_Subs")
Set MyOutlook = New Outlook.Application

If objOutlook Is Nothing Then

End If

Set MyOutlook = New Outlook.Application

rst.MoveFirst
Do Until rst.EOF
Set MyMail = MyOutlook.CreateItem(olMailItem)
'MyMail.SentOnBehalfOfName = "info@nzrwelfare.co.nz"

MyMail.To = rst!EmailAddress

MyMail.Subject = "NZR Welfare Trust Subs Invoice"
MyMail.Body = "Dear valued trust member" & Chr(13) & Chr(13) & "Please find attached your group membership invoice." & Chr(13) & Chr(13) & "Thank you from your Welfare team" & Chr(13) & Chr(13) & "Don't forget to like us on Facebook at NZ Railways Staff Welfare Trust"

Attach = "T:\BCE_Subs_Export\" & rst!MemberNumber & ".pdf"
MyMail.Attachments.Add Attach

MyMail.Send

rst.MoveNext

Loop
Set MyMail = Nothing
Set MyOutlook = Nothing

End Sub

 

[pbaldy]

How does it fail? I have this in an app and it works fine:

MyMail.SentOnBehalfOfName = "Blah@DomainName.com"

We're in an Exchange server environment, not sure if that matters. Also, mine displays for the user instead sending, as they like to review. Try that just to see if that's a factor.