send emails from subform

[alpedro]

hello (i will try to write well, i don't speak well english)

i have a form that filter a subform. i would like to send emails address (filtered) to outlook.

how do i do the code?
Thanks.

 

[Ranman256]

use the query in the subform to pull the list send the subform query to the routine below.
This will have the name,email of the people to send to.
Then click a Send button to run ScanAndEmail below.
It will run thru the list and send the report/sheet

'------------
Public Sub ScanAndEmail(byval pvQry)
'------------
Dim vTo, vSubj, vBody, vRpt
Dim vFilePath
dim i as integer
 set rst = currentdb.openrecordset(pvQry)
with rst
   while not .eof
      vEmail = .fields("Email").value & ""
   
      vBody = "body of email"
      vSubj = vRpt
   
      DoCmd.SendObject acSendQuery,  "qs1Rec", acFormatXLS, vEmail , , , "Subject", "message"   'send xl data
       '--or --
      DoCmd.SendObject acSendReport,  cboRpt, acFormatPDF, vEmail , , , "Subject", "message"   'send report
       .movenext   'next record
    wend
end with
set rst = nothing
End Sub

 

[alpedro]

i would like to have a button EMAILs from emails filered something like this:
Private Sub btn_EMAILs_Click()

Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim TheAddress As String


Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("SELECT * FROM ....

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

' Create the e-mail message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
TheAddress = ""

Do Until MyRS.EOF
If TheAddress = "" Then
TheAddress = MyRS![EMAI L]
Else
TheAddress = TheAddress & ";" & MyRS![EMAI L]
End If
MyRS.MoveNext
Loop

objOutlookMsg.Display

Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub