Dim qd As DAO.QueryDef
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = Currentdb
Set qd = db.QueryDefs("YourQuery")
Set rs = qd.OpenRecordset(dbOpendynaset)
Set qd = Nothing
With rs
If Not (.BOF and .EOF)
.MoveFirst
End If
Do Until .EOF
docmd.SendObject ObjectType:=acSendQuery,ObjectName:="YourQuery",OutputFormat:=acFormatXLX,To:=rs("emailField"),Subject:="yourSubject",MessageText:="the message"
.MoveNext
Loop
.Close
End With
Set rs = Nothing
Set db =Nothing
seems not to like this If Not (.BOF and .EOF)you can use DoCmd.SendObject:
you also need to open a recordset from the query
and loop through each record:
Code:Dim qd As DAO.QueryDef Dim db As DAO.Database Dim rs As DAO.Recordset Set db = Currentdb Set qd = db.QueryDefs("YourQuery") Set rs = qd.OpenRecordset(dbOpendynaset) Set qd = Nothing With rs If Not (.BOF and .EOF) .MoveFirst End If Do Until .EOF docmd.SendObject ObjectType:=acSendQuery,ObjectName:="YourQuery",OutputFormat:=acFormatXLX,To:=rs("emailField"),Subject:="yourSubject",MessageText:="the message" .MoveNext Loop .Close End With Set rs = Nothing Set db =Nothing
You need
You have to try and do some of the work yourself?Code:If Not (.BOF and .EOF) then
Dim rst
Dim XL As Excel.Application
Set XL = CreateObject("excel.application")
Dim vFile
vFile = " Templates Location\Template.xlsx"
Set rst = CurrentDb.OpenRecordset("Booked Notification To Agent Master")
With XL
.Visible = False
.Workbooks.Open vFile
.Sheets("Bookings").Select
.Range("A4").Select
.ActiveCell.CopyFromRecordset rst
.ActiveWorkbook.SaveAs ("Location and file name\Booking Notification " & Format(Now(), "DD-MMM-YYYY hhmm ") & ".xlsx")
.ActiveWorkbook.Close
.Application.Quit
Dim qd As DAO.QueryDef
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set qd = db.QueryDefs("Booked Notification To Agent Master")
Set rs = qd.OpenRecordset(dbOpenDynaset)
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail ' This creates a blank email and captures the users default signature.
.BodyFormat = olFormatHTML
.Display
End With
Set qd = Nothing
With rs
.MoveFirst
signature = OutMail.HTMLBody
strbody = "Hi,<br>" & _
"Please find attached booking notification report.<br>" & _
"Let me know if you have problems.<br>" & _
"<br><br>Best wishes,<br>"
With OutMail
.To = rs("Email")
.CC = ""
.BCC = ""
.Subject = " Booking Notifications"
.HTMLBody = strFntNormal & strbody & strTableBody & "<br><br>" & signature
.Attachments.Add " Location and file name Booking Notification " & Format(Now(), "DD-MMM-YYYY hhmm ") & ".xlsx""
.MoveNext
.Close
End With
Set rs = Nothing
Set db = Nothing
End With
End With
End Sub
Sure am, so this is my code it works but it is only sending an email to 1 of the 3 so maybe i have missed something
Code:Dim rst Dim XL As Excel.Application Set XL = CreateObject("excel.application") Dim vFile vFile = " Templates Location\Template.xlsx" Set rst = CurrentDb.OpenRecordset("Booked Notification To Agent Master") With XL .Visible = False .Workbooks.Open vFile .Sheets("Bookings").Select .Range("A4").Select .ActiveCell.CopyFromRecordset rst .ActiveWorkbook.SaveAs ("Location and file name\Booking Notification " & Format(Now(), "DD-MMM-YYYY hhmm ") & ".xlsx") .ActiveWorkbook.Close .Application.Quit Dim qd As DAO.QueryDef Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set qd = db.QueryDefs("Booked Notification To Agent Master") Set rs = qd.OpenRecordset(dbOpenDynaset) Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail ' This creates a blank email and captures the users default signature. .BodyFormat = olFormatHTML .Display End With Set qd = Nothing With rs .MoveFirst signature = OutMail.HTMLBody strbody = "Hi,<br>" & _ "Please find attached booking notification report.<br>" & _ "Let me know if you have problems.<br>" & _ "<br><br>Best wishes,<br>" With OutMail .To = rs("Email") .CC = "" .BCC = "" .Subject = " Booking Notifications" .HTMLBody = strFntNormal & strbody & strTableBody & "<br><br>" & signature .Attachments.Add " Location and file name Booking Notification " & Format(Now(), "DD-MMM-YYYY hhmm ") & ".xlsx"" .MoveNext .Close End With Set rs = Nothing Set db = Nothing End With End With End Sub
Yes, if you were to use criteria to select only the email recipient that you need, you could so that.?Thanks i did that and this is where it gets stuck
.MoveNext
so the 1st email address get the full list but then stops, can yo not just email the individual with their bookings only rather than the full list i wonder
Sub indentText()
Dim rst
Dim XL As Excel.Application
Set XL = CreateObject("excel.application")
Dim vFile
vFile = " Templates Location\Template.xlsx"
Set rst = CurrentDb.OpenRecordset("Booked Notification To Agent Master")
With XL
.Visible = False
.Workbooks.Open vFile
.Sheets("Bookings").select
.Range("A4").select
.ActiveCell.CopyFromRecordset rst
.ActiveWorkbook.SaveAs ("Location and file name\Booking Notification " & Format(Now(), "DD-MMM-YYYY hhmm ") & ".xlsx")
.ActiveWorkbook.Close
.Application.Quit
Dim qd As DAO.QueryDef
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set qd = db.QueryDefs("Booked Notification To Agent Master")
Set rs = qd.OpenRecordset(dbOpenDynaset)
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail ' This creates a blank email and captures the users default signature.
.BodyFormat = olFormatHTML
.display
End With
Set qd = Nothing
With rs
.MoveFirst
Signature = OutMail.HTMLBody
strbody = "Hi,<br>" & _
"Please find attached booking notification report.<br>" & _
"Let me know if you have problems.<br>" & _
"<br><br>Best wishes,<br>"
With OutMail
.To = rs("Email")
.CC = ""
.BCC = ""
.Subject = " Booking Notifications"
.HTMLBody = strFntNormal & strbody & strTableBody & "<br><br>" & Signature
.Attachments.Add " Location and file name Booking Notification " & Format(Now(), "DD-MMM-YYYY hhmm ") & ".xlsx"""
.MoveNext
.Close
End With
Set rs = Nothing
Set db = Nothing
End With
End With
End Sub