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

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

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

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

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

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

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