2
\$\begingroup\$

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 = "main.clerk@smth.com" ' Main recipient clerk
    Const SECOND_ADDRESS = "deputy.clerk@smth.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
\$\endgroup\$
  • \$\begingroup\$ I'd reorder askToCancel to be below checkStateOfMail since it's only called in that function whereas the other is called from the sub. \$\endgroup\$ – Raystafarian Jan 29 '16 at 16:41
2
\$\begingroup\$

For multiple address, why not have a collection of emails?

Public Function GetSendToList () As Collection

    Dim emailList As Collection
    Set emailList = New Collection

    emailList.Add "main.clerk@smth.com"
    emailList.Add "deputy.clerk@smth.com"
    emailList.Add etc.

    Set GetSendToList = emailList

End Function

And then:

Dim emailList as Collection
Set emailList = GetSendToList

...
...
...

For i = 1 to emailList.Count
    emailToCheck = emailList(i)
    '/ code to check the email against your message
Next i

This means that you can:

  • Keep your hard-coded list away from your business logic, making both cleaner and easier to find

  • Have just one place you go to to add/remove emails from your list, rather than wading through a sub to find it.

  • Have just one (validate email) loop, so you don't have to repeat your code for each one.

In my projects, I often have a separate module for "Manually-Set Values" but that's just personal preference.

\$\endgroup\$
  • \$\begingroup\$ Hey ..., thanks a lot. :) I should have mentioned in my post that I'm not deep into VBA. ;) \$\endgroup\$ – bo256 Jan 29 '16 at 13:51
1
\$\begingroup\$

Just one thing I noted from askToCancel

  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

vbYesNoCancel returns a numeric value. So why not simplify those ifs with something like this -

    Dim answer As Long
    answer = MsgBox(boxMessage & vbLf & "Send mail anyway?", vbYesNoCancel, boxTitle)
        If answer = 6 Then
            asktocancel = True
        Else: asktocancel = False
        End If
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.