For anybody interested in doing something similar here is the VBA code in the Form that send data from various queries to an Emailing Module
Code:
Private Sub Form_Load()
On Error GoTo errorcatch
filename = "OneDayEmails"
rep = "1"
Call sendemails(filename, rep)
filename = "TodaysEmails"
rep = "2"
Call sendemails(filename, rep)
filename = "ThreeDayEmails"
rep = "3"
Call sendemails(filename, rep)
MsgBox "done"
Exit Sub
errorcatch:
MsgBox Err.Description
End Sub
Here is the VBA Code in the Module that sends the VBA code to the Person in the Record in a field called initials and a copy (in a different format) to the administrator.
Code:
Public filename As String, rep As String
Public Sub sendemails(filename As String, rep As String)
Dim subject As String, Body As String, EmailAddress As String, emailadmin As String, adminbody As String, adminsubject As String
Dim rs As Object, recount As Integer, count As Integer, rst As Object, initrecount As Integer, initcount As Integer
Dim sql As String
On Error GoTo errorcatch
Set rst = CurrentDb.OpenRecordset("IntitialsQuery")
rst.MoveLast
rst.MoveFirst
initrecount = rst.RecordCount
For initcount = 1 To initrecount
EmailAddress = rst![emailAddress]
subject = ""
Body = rst![Name] & "," & Chr$(13) & Chr$(13)
sql = "SELECT * " & _
"FROM " & filename & _
" WHERE Initials = '" & rst![InitialID] & "'"
Set rs = CurrentDb.OpenRecordset(sql)
If rs.RecordCount > 0 Then
rs.MoveLast
rs.MoveFirst
recount = rs.RecordCount
For count = 1 To recount
subject = subject & rs![File Number] & " "
Body = Body & "FILE NUMBER: " & rs![File Number] & Chr$(13) & "UNIT NUMBER: " & rs![Unit No] & Chr$(13) & "UNIT NAME: " & rs![Unit Name] & Chr$(13) & Chr$(13)
rs.MoveNext
Next count
Body = Body & "Drawings submission is due on " & Date + 1
Body = Body & ". This is Report (" & rep & "). Please do the needful within this day." & Chr$(13) & Chr$(13) & "Thank you!" & Chr$(13) & Chr$(13) & "Administrator"
'MsgBox subject & vbNewLine & Body
End If
rs.Close
If subject <> "" Then DoCmd.SendObject , , , EmailAddress, , , subject, Body, False
rst.MoveNext
Next initcount
'MsgBox subject & vbNewLine & Body
Set rs = CurrentDb.OpenRecordset(filename)
adminbody = "Administrator, please note. " & Chr$(13) & Chr$(13)
emailadmin = "email goes here"
If rs.RecordCount > 0 Then
rs.MoveLast
rs.MoveFirst
recount = rs.RecordCount
For count = 1 To recount
adminsubject = adminsubject & rs![File Number] & " "
adminbody = adminbody & "FILE NUMBER: " & rs![File Number] & Chr$(13) & "UNIT NUMBER: " & rs![Unit No] & Chr$(13) & "UNIT NAME: " & rs![Unit Name] & Chr$(13) & Chr$(13)
rs.Edit
If rep = "1" Then rs!emailalertsent1 = -1
If rep = "2" Then rs!emailalertsent2 = -1
If rep = "3" Then rs!emailalertsent3 = -1
rs.Update
rs.Bookmark = rs.LastModified
rs.MoveNext
Next count
adminbody = adminbody & "Drawings submission is due on " & Date + 1 & Chr$(13) & Chr$(13)
'MsgBox adminsubject & vbNewLine & adminbody
DoCmd.SendObject , , , emailadmin, , , adminsubject, adminbody, False
End If
rs.Close
Set rs = Nothing
rst.Close
Set rst = Nothing
Exit Sub
errorcatch:
MsgBox Err.Description
End Sub
Note it uses 2 Public Variables, filename and rep to pass the data to the Module