Hi all
I'm tearing my hair out on this one, and I know its simple.....but....
I have 2 queries:
qryContact = tblContact.contactname & tblContactEmail
qryExpiringPermit = tblFleet.Fleet_Num, tblPermits.DateFrom, tblPermits.DateTo, tblPermits.PermitNumber, tblPermitTypes.PermitType
Here's a module I want to use that sends an email based on qryExpiringpermit to each record in qryContact....here's the module:
any ideas?
I'm tearing my hair out on this one, and I know its simple.....but....
I have 2 queries:
qryContact = tblContact.contactname & tblContactEmail
qryExpiringPermit = tblFleet.Fleet_Num, tblPermits.DateFrom, tblPermits.DateTo, tblPermits.PermitNumber, tblPermitTypes.PermitType
Here's a module I want to use that sends an email based on qryExpiringpermit to each record in qryContact....here's the module:
Code:
Function EMail()
On Error GoTo Mailerr
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strCount
Set db = CurrentDb
Set rst = db.OpenRecordset("qryContacts")
rst.MoveFirst
Do Until rst.EOF
strTo = rst.Fields("Email")
strSubject = "The following Permits are expiring within the next 30 days"
ContactNAme = rst.Fields("ContactNAme")
strCount = 0
Set rst = Nothing
Set rst = db.OpenRecordset("qryExpiringPermits")
While Not rst.EOF And Not rst.BOF
strCount = strCount + 1
rst.MoveNext
Wend
If strCount = "" Then
strBody = ContactNAme & vbNewLine
strBody = strBody & "There are no permits expiring in the next 30 days!"
Else
strBody = "Good morning " & ContactNAme & vbNewLine
strBody = strBody & "The following permits are expyring within the next 30 days:" & vbNewLine
rst.MoveFirst
Do Until rst.EOF = True
strBody = strBody & "Fleet #: " & rst.Fields("Fleet_Num") & vbNewLine
strBody = strBody & "Permit Type #: " & rst.Fields("PermitType") & vbNewLine
strBody = strBody & "Permit Duration: " & rst.Fields("DateFrom") & " To " & rst.Fields("DateTo")
strBody = strBody & "Permit Number: " & rst.Fields("PermitNumber")
rst.MoveNext
Loop
End If
DoCmd.SendObject , , acFormatHTML, strTo, , , strSubject, strBody, False
Set rst = Nothing
Set rst = db.OpenRecordset("qryContacts")
rst.MoveNext
Loop
Set rst = Nothing
Set rst2 = Nothing
Set db = Nothing
Mailend:
Exit Function
Mailerr:
MsgBox Err.Description
Resume Mailend
End Function
any ideas?