Every week I've got to send a report to a clerk. I also have to add his deputy in case the clerk isn't available. For not to forget the second recipient and the attachment I've wrote myself this VBA-Macro. Perhaps one could enhance it in a way that it works with more then two recipients? Any comments and suggestions welcome!
' Main Sub which defines the mail-addresses to check. Then checks if one ' of the addresses is used. In case of used it checks the remaining ' constraints. Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim firstRecipient As String ' Define the addresses to check for. Const FIRST_ADDRESS = "firstname.lastname@example.org" ' Main recipient clerk Const SECOND_ADDRESS = "email@example.com" ' Deputy On Error GoTo stopSending ' Getting the first mail address from the outlook GUI. firstRecipient = Application.ActiveInspector.CurrentItem.Recipients.Item(1).Address ' If the first recipient is the specified clerk then check for the deputy. If (InStr(1, firstRecipient, FIRST_ADDRESS, vbTextCompare) <> 0) Then If checkStateOfMail(SECOND_ADDRESS, True) = False Then Cancel = True Exit Sub End If ' If the first recipient is the deputy then check for the specified clerk. ElseIf (InStr(1, firstRecipient, SECOND_ADDRESS, vbTextCompare) <> 0) Then If checkStateOfMail(FIRST_ADDRESS, True) = False Then Cancel = True Exit Sub End If End If ' ... if none of both is specified as recipient then just go on. Exit Sub stopSending: MsgBox "Runtime error occured.", vbCritical, "Runtime error!" Cancel = True End Sub ' If a doubtful condition has been detected then the user is asked if to cancel ' cancel or not. ' Parameter ' 1. String - Text for the message box. ' 2. String - Title for the message box. ' Return ' Boolean - Answer if sending shall be cancelled or not. Function askToCancel(boxMessage As String, boxTitle As String) As Boolean Dim answer As String answer = MsgBox(boxMessage & vbLf & "Send mail anyway?", vbYesNoCancel, boxTitle) If answer = vbNo Then askToCancel = True ElseIf answer = vbCancel Then askToCancel = True Else askToCancel = False End If End Function ' Optional: Checks if an mail-attachment exists. ' Checks if two recipients exist. If case of two recipient it checks the ' correctness of the second address. ' Parameter ' 1. String - Expected second address. ' 2. Boolean - Checking for attachment or not. ' Return ' Boolean - Mail in correct state or not. Function checkStateOfMail(expectedSecond As String, checkAttachment As Boolean) As Boolean Dim olObj As Object Dim attachmentCount As Variant Dim secondRecipient As String On Error GoTo errorOccured Set olObj = Application.ActiveInspector.CurrentItem If checkAttachment = True Then ' Get the count of mail attachments. attachmentCount = olObj.Attachments.count If attachmentCount = 0 Then If askToCancel("E-Mail Attachment doesn't exist.", "Caution - Attachment") = True Then checkStateOfMail = False Exit Function End If End If End If ' Two recipients are expected. If olObj.Recipients.count < 2 Then If askToCancel("Second recipient not available.", "Forgot 2nd recipient?") = True Then checkStateOfMail = False Exit Function End If Else ' Two recipients are available. But the second address could be wrong. secondRecipient = olObj.Recipients.Item(2).Address If InStr(1, secondRecipient, expectedSecond, vbTextCompare) = 0 Then If askToCancel("Second recipient isn't correct.", "Caution!") = True Then checkStateOfMail = False Exit Function End If End If End If checkStateOfMail = True Exit Function errorOccured: MsgBox "Runtime error occured in sub procedure.", vbCritical, "Runtime error!" Exit Function End Function