Query output to emails

[Fozi]

I have a query that lists clients due to submit claims. From this list I'd like to automate an email for each client informing them of this. Struggling to work out the best way.

Tips appreciated.
Thanks

 

[modest]

VBA, load a recordset and loop through it. You can send one at a time or BCC them all.

 

[Fozi]

VBA, load a recordset and loop through it. You can send one at a time or BCC them all.

Thanks for getting back to me. I'll give it a go but I'm a VBA numpty. Are there any routines you could point me in the direction off to adapt?

Cheers

 

[TedMartin]

e-Mail

Lots on this site but try and pick the code out of this Module.

I don't claim any credit for the basic code as I took it from this site anyway. I have just adapted it to include an attachment too.

One thing though, because XP has a virus scanning check on e-mails being sent out, you will have to "approve" each e-mail as it is being sent to the Outlook Outbox. Outlook sees the e-mail being generated by code and thinks its a virus. There is a way to turn it off (also on this site) but I would not recommend it.

Have fun

_________________________________________

Option Compare Database
Option Explicit
' You need to declare a reference to the Outlook library, and the filesystemobject.
' this is not as hard as it sounds.
'
' Look in the menu above, and click Tools, then select References
'
' Scroll down the list until you see
' Microsoft Scripting Runtime -- and put a check next to it (if one is not there already)
'
' Microsoft Outlook Object Library -- check that.
' There will be some version number there as well; it doesn't matter.
' This will work with Outlook98 and Outlook2000


Public Function SendeMailAttachment()

Dim db As DAO.Database
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
'

Dim FileAttachment As String
'

'Trap to handle No Send virus check
On Error GoTo NoSend
'
'
Dim Response As String
'
'Write the e-mail body
DoCmd.OpenForm "F-emailbodytext", , , , , acDialog
'
'Now output the file
DoCmd.OutputTo acReport, "R-emailbodytext", "MS-DOSText(*.txt)", "c:\temp\emailbody.txt", False, "", 0
'
'Response = MsgBox("This quotation will be sent with the default message", _
'vbYesNo, "No to Change")
'If Response = vbNo Then
'MsgBox "Change the default message in c:\temp\emailbody.txt", vbExclamation, "Exiting ..."
'FollowHyperlink "c:\temp\emailbody.txt"
'Exit Function
'End If
'
Set fso = New FileSystemObject

' First, we need to know the subject. We can't very well be sending around blank messages...

'We Need A Subject Line!")
Subjectline$ = "Quotation"
'
'Default file name and path
BodyFile$ = "c:\temp\emailbody.txt"
'

If BodyFile$ = "" Then
MsgBox "No body, no message." & vbNewLine & vbNewLine & "Quitting...", vbCritical, "I Ain't Got No-Body!"
Exit Function
End If

' Check to make sure the file exists...
If fso.FileExists(BodyFile$) = False Then
MsgBox "The body file isn't where you say it is. " & vbNewLine & vbNewLine & "Quitting...", vbCritical, "I Ain't Got No-Body!"
Exit Function
End If

' Since we got a file, we can open it up.
Set MyBody = fspenTextFile(BodyFile, ForReading, False, TristateUseDefault)

'and read it into a variable.
MyBodyText = MyBody.ReadAll

' and close the file.
MyBody.Close

' Now, we open Outlook for our own device..
Set MyOutlook = New Outlook.Application

' Set up the database and query connections

Set db = CurrentDb()
'
Set MyMail = MyOutlook.CreateItem(olMailItem)

' This addresses it

MyMail.To = strQuotationeMail

'This gives it a subject
MyMail.Subject = Subjectline$

'This gives it the body
MyMail.Body = MyBodyText
'
FileAttachment$ = "c:\temp\quotation.pdf"
'
'Now check that the file exists - if the file has been output, it will be!!
'
If fso.FileExists(FileAttachment$) = False Then
'
MsgBox "The Attachment file is not where you say it is. " & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "Incorrect file path"
Exit Function
End If
'
MyMail.Attachments.Add FileAttachment$, olByValue, 1, "Quotation"
'
'This sends it!
MyMail.Send

'Cleanup after ourselves
CleanUp:

Set MyMail = Nothing

'Uncomment the next line if you want Outlook to shut down when its done.
'... otherwise, it will stay running.

'MyOutlook.Quit
Set MyOutlook = Nothing

db.Close
Set db = Nothing
'
Exit Function
'Trap to handle No Send dialogue
NoSend:
'
If Err.Number = 286 Then
MsgBox "Send to Outbox Stopped", vbCritical, "Send Stopped"
GoTo CleanUp
'
Else
MsgBox "Send or Programme Error - seek Help", vbCritical, "Send Stopped"
GoTo CleanUp
End If
'
End Function