My problem is with this part:
Code:
If DocumentRequired = Yes And DocumentECopy = No And DocumentExpiryDate <> Null And Weekday(Date) = Weekday(DocumentExpiryDate) Then
Complete code:
Code:
Private Sub Form_Timer()
'Email will send every second if not properly coded!!! REMEMBER TO DEFINE CDAT
Dim rst As Recordset
Dim rc As String, sj As String, bd As String, ea As String, cc As String
Set rst = CurrentDb.OpenRecordset("qryDocuments")
If cdat <> Date Then
cdat = Date: cc = ""
rst.MoveFirst
Do While rst.EOF = False
ea = rst!WorkEmail
rc = rst!Fullname & " " & rst!Surname
If rst!RoleResponsibility = "Office Manager" Then cc = rst!WorkEmail & ";"
If rst!RoleResponsibility = "Owner" Then cc = cc & rst!WorkEmail
'Passport expire in 90 days
sj = "Important Notification for " & rc
bd = ""
bd = bd & "Dear " & rc & Chr(13) & Chr(13)
bd = bd & "Your passport will expire in 90 days (" & rst!DocumentExpiryDate & ")." & Chr(13)
bd = bd & "Arrange for the renewal of the document as soon as possible. "
bd = bd & "Please submit a copy of the renewed document to management before " & rst!DocumentExpiryDate & "."
fncEmail ea, sj, bd, cc
'All other documents with expiry dates
sj = "Critical Notification for " & rc
bd = ""
bd = bd & "Dear " & rc & Chr(13) & Chr(13)
bd = bd & "The following document will expire on " & rst!DocumentExpiryDate & ":" & Chr(13)
bd = bd & rst!Document & Chr(13)
bd = bd & "Expiry Date: " & rst!DocumentExpiryDate & Chr(13) & Chr(13)
bd = bd & "Arrange for the renewal of the document as soon as possible. "
bd = bd & "Please submit a copy of the renewed document to management before " & rst!DocumentExpiryDate & "."
fncEmail ea, sj, bd, cc
rst.MoveNext
Loop
Set rst = CurrentDb.OpenRecordset("tblDocuments")
If rst.RecordCount = 0 Then MsgBox ("No documents loaded."): Exit Sub
rst.MoveFirst 'Possible run-time error when no documents loaded yet
Do While rst.EOF = False
'Copies of documents required - with expiry dates
If DocumentRequired = Yes And DocumentECopy = No And DocumentExpiryDate <> Null And Weekday(Date) = Weekday(DocumentExpiryDate) Then
sj = "Important Notification for " & rc
bd = ""
bd = bd & "Dear " & rc & Chr(13) & Chr(13)
bd = bd & "An electronic copy is required for the following document:" & Chr(13)
bd = bd & rst!Document & Chr(13)
bd = bd & "Please submit a copy of the document to management before " & rst!DocumentExpiryDate & "."
fncEmail ea, sj, bd, cc
End If
'Copies of documents required - without expiry dates
If DocumentRequired = Yes And DocumentECopy = No And DocumentExpiryDate = Null And Weekday(Date) = 4 Then
sj = "Important Notification for " & rc
bd = ""
bd = bd & "Dear " & rc & Chr(13) & Chr(13)
bd = bd & "An electronic copy is required for the following document:" & Chr(13)
bd = bd & rst!Document & Chr(13)
bd = bd & "Please submit a copy of the document to management before " & Date + 7 & "."
fncEmail ea, sj, bd, cc
End If
rst.MoveNext
Loop
End If
End Sub
The fncEmail code is modular:
Code:
Function fncEmail(Recipient As String, Subject As String, Body As String, Copy As String)
Dim outApp As Outlook.Application
Dim outMail As MailItem
Set outApp = CreateObject("Outlook.application")
Set outMail = outApp.CreateItem(olMailItem)
outMail.Body = Body
outMail.Subject = Subject
outMail.To = Recipient
outMail.cc = Copy
'outMail.Attachments
outMail.Send
Set outMail = Nothing
Set outApp = Nothing
End Function