VBA: Find whether there is common pattern between the email subject and attachment name

Question

I want to validate that the outgoing email is correctly attached with a correct file. The email subject contains a code. The attachment filename is automatically generated with a code and attached manually to the email. The VBA is to check whether the email subject contains a common pattern in the filename of the attachment.

The code is like H??#######, i.e. it must start with "H", followed with 2 letters, and then 7 digits.

If both the email subject and filename contain the same code, the email is allowed to send, otherwise it should warn. For example:

Subject: Urgent Chapter 10 - HCX1234567 updated on 12 Dec 2015

Filename: HCX1234567_ABCCh10_20151212_0408

This email is allowed.

Is it possible to do such validation before sending?

Here is my attempt:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Create Geoff Lai on 14 March 2016

Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor

Dim prompt As String
Dim strMsg As String
Dim mailContent As String
Dim jobCode As String
Dim attachName As String
Dim pos As Integer
Dim jcodepos As Integer

Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

attachName = Item.Attachments.Item(1).FileName

mailContent = Item.Body + Item.Subject    ' Get a copy of all the e-mail body text and subject text to search.
mailContent = LCase(mailContent)          ' Make whole string lowercase for easier searching.

Set recips = Item.Recipients
For Each recip In recips        'Record email addressees if send to external domain
    Set pa = recip.PropertyAccessor
        If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@mydomain.com") = 0 Then
            strMsg = strMsg & "   " & pa.GetProperty(PR_SMTP_ADDRESS) & vbNewLine
        End If
Next
If strMsg <> "" Then
    If (Item.Attachments.Count = 0) Then      ' Check attachment
        If InStr(1, mailContent, "attach") > 0 Then
            pos = 1
            ElseIf InStr(1, mailContent, "Attach") > 0 Then
                pos = 1
            ElseIf InStr(1, mailContent, "enclose") > 0 Then
                pos = 1
            ElseIf InStr(1, mailContent, "Enclose") > 0 Then
                pos = 1
            Else: pos = 0
        End If
    End If
    If (pos > 0) Then       'If there is no attachment:
        If MsgBox("With the word attach or enclose, attachment should be found in this email" & vbNewLine & "Please Confirm.", vbYesNo + vbCritical + vbMsgBoxSetForeground, "Missing Attachment") = vbYes Then
            prompt = "This email will be sent outside of mydomain.com to:" & vbNewLine & strMsg & "Do you want to proceed?"
            If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
                Cancel = True
                Exit Sub
                Else
                    Exit Sub
            End If
            Else
                Cancel = True       'Stop sending
        End If
    End If
    If (Item.Attachments.Count > 0) Then        ' Validate attachment and subject
        jcodepos = InStr(1, attachName, "H??#######", 0)    ' Get job code position
        jobCode = Mid(attachName, jcodepos, 10)       ' Get job code
        If (InStr(1, Item.Subject, jobCode, 0) = 0) Then        ' If no common code between subject and attachment
            If MsgBox("There is no common job code between the email subject and the filename of the attachment." & vbNewLine & "Do you want to proceed?", _
                vbYesNo + vbCritical + vbMsgBoxSetForeground, "Wrong Attachment?") = vbNo Then
                Cancel = True
                Exit Sub
                Else
                    Exit Sub
            End If
            ElseIf MsgBox("Common job code " & jobCode & " is found in the email subject and the filename of the attachment" & prompt, _
                vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Confirm Job Code") = vbNo Then       ' If common code is found
                Cancel = True
                Exit Sub
                Else
                    Exit Sub
        End If
    End If
End If
End Sub

However, I get an error at jobCode = Mid(attachName, jcodepos, 10), which is:

Run-time error '5' Invalid procedure call or argument

Answer 1

Application_ItemSend, the usual way, in ThisOutlookModule. How can I automatically run a macro when an email is sent in Outlook?

In the VB editor set the reference to Regular Expressions.

Similar to the code in the Question part of Regular Expression Rules in Outlook 2007?. Check RegEx.Pattern = "(H[A-Z]{2}[0-9]{7})" against the filename. Continue with RegEx or InStr to verify the subject includes the filename match.