Code:
'collect all the emails in the subform
sub btnSendEmails_click()
dim vTo
with me.subform.form.recordset
.movefirst
while not .eof
vTo = vTo & ";"
.movenext
wend
'send email
email1 vTo, "subject mater" , "body of email"
end sub
Public Function Email1(ByVal pvTo, ByVal pvSubj, ByVal pvBody) As Boolean
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
'-------
'YOU MUST ADD THE OUTLOOK APP IN REFERENCES!!! checkmark MICROSOFT OUTLOOK OBJECT LIBRARY in the vbE menu, Tools, References
'-------
On Error GoTo ErrMail
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(olMailItem)
With oMail
.To = pvTo
.Subject = pvSubj
.Body = pvBody
.Send
End With
Email1=true
Set oMail = Nothing
Set oApp = Nothing
Exit Function
ErrMail:
MsgBox Err.Description, vbCritical, Err
Resume Next
End Function