Private Sub cmdLetter1_Click()
'Send a message if tickbox is already ticked
On Error GoTo PROC_ERR
Me.Refresh
If CheckLetter1 = True Then
MsgBox "The tickbox is ticked which indicates that a letter or email has been sent." _
& Chr(13) & "If you wish to send another please untick the box. ", vbOKOnly, Warning
End
End If
'-----Error happens here-----
'Check whether to email or post
Email.SetFocus
'Stop error if email isnt sent
On Error GoTo Error
If Email.Text <> "" Then
SendEmail 'Function
Error:
Resume Next
Else
'Post
'Had to use this routine to make the report print in colour
Dim stDocName As String
stDocName = "rptCustLetter1"
DoCmd.OpenReport stDocName, acViewPreview
With Reports(rptCustLetter1).Printer
.ColorMode = acPRCMColor
End With 'end of colour enforcement
DoCmd.OpenReport "rptCustLetter1", acViewNormal
DoCmd.Close
End If
'Tick to indicate letter is sent
SentStage1 = Date
CheckLetter1.Value = True
Calculator 'Function
DoCmd.Restore
PROC_ERR_EXIT:
Exit Sub
PROC_ERR:
MsgBox Err.Number & ": " & Err.Description
'Resume PROC_ERR_EXIT
End Sub
Private Sub cmdLetter1_Click()
On Error GoTo PROC_ERR
' Save any changes
If Me.Dirty Then Me.Dirty = False
' Display a message and quit sub if tickbox is already ticked
If Me.CheckLetter1.Value = True Then
MsgBox "The tickbox is ticked which indicates that a letter or email has been sent." & _
Chr(13) & "If you wish to send another please untick the box. ", vbOKOnly, Warning
Exit Sub
End If
' Email if Email field is ticked, otherwise print letter
If Len(Me.[Email].Value & vbNullString) <> 0 Then
SendEmail 'Function
Else
' Had to use this routine to make the report print in colour
DoCmd.OpenReport "rptCustLetter1", acViewPreview
Reports(rptCustLetter1).Printer.ColorMode = acPRCMColor
DoCmd.OpenReport "rptCustLetter1", acViewNormal
DoCmd.Close
End If
' Tick to indicate letter is processed
Me.SentStage1.Value = Date
Me.CheckLetter1.Value = True
Calculator 'Function
DoCmd.Restore
PROC_ERR_EXIT:
Exit Sub
PROC_ERR:
MsgBox Err.Number & ": " & Err.Description
Resume PROC_ERR_EXIT
End Sub
Public Function SendEmail()
Dim appOutLook As Object
Dim MailOutLook As Object
'create the report temporarily
DoCmd.OutputTo acOutputReport, "rptCustLetter1", acFormatRTF, "d:\data files\Report1.rtf", False
'assign our object references
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
'set the recipient list
With MailOutLook
.To = Email
'set the subject
.Subject = "Outstanding Payment"
'set the body text
.body = "The attachment is a reminder invoice for fees for ID No." & CustID & Chr(13) & _
"at" & comboCourse & Chr(13) & _
"started on " & StartDate & Chr(13) & _
"Please open the attached file"
'add the reports we created
.attachments.Add "d:\data files\Report1.rtf"
'send the email
.Send
End With
'tidy up..
'get rid of our object references
Set appOutLook = Nothing
Set MailOutLook = Nothing
'delete our temporary files
Kill "d:\data files\Report1.rtf"
Calculator
End Function