asked on

Email checker opt out - Outlook

I have the script running below which works very well and has helped me to look less foolish.

I also have a script which emails the contents of a business contact manager task to an assigned user. However it always asks 'Have you included everybody?', it doesn't seem to bother with the spell check. But that doesn't matter as I would like it to bypass this checking completely. Could there be a four digit code in the body of the email and that means the email checker doesn't run?

Thanks Ed.

'DO NOT DELETE BELOW THIS LINE.
 
 
'Email Checker, empty subject line, missing attachments, final check have you cc'd everyone
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 
    Dim m As Variant
    Dim strBody As String
    Dim intIn, intLength As Long
    Dim intAttachCount As Integer, intStandardAttachCount As Integer
 
    On Error GoTo ErrorHandler
    intStandardAttachCount = 0
 
 
    'CHECK #1: Check for a blank subject line
    If Item.Subject = "" Then
        m = MsgBox("The subject line is not specified." & _
        vbNewLine & vbNewLine & _
            "Do you still want to send this message? ", _
            vbYesNo + vbExclamation, "Microsoft Office Outlook")
        If m = vbNo Then
            Cancel = True
            GoTo ExitSub
        End If
    End If
 
'CHECK #2: Check for a missing attachment
    intIn = 0
    strBody = LCase(Item.Body)
    'If the message is a reply or forward, then the macro will
    'not search for the strings in the original message. Anything
    'below the "from:" line is ignored
    intLength = InStr(1, strBody, "from:")
    If intLength = 0 Then intLength = Len(strBody)
        '
        'Add lines for every string you want to check, including other
        'languages, etc. Partial strings are fine. For example, "attach"
        'will match "attached" & "attachment"
        If intIn = 0 Then intIn = InStr(1, Left(strBody, intLength), "attach")
        If intIn = 0 Then intIn = InStr(1, Left(strBody, intLength), "file")
        If intIn = 0 Then intIn = InStr(1, Left(strBody, intLength), "enclosed")
        If intIn = 0 Then intIn = InStr(1, Item.Subject, "attach")
        If intIn = 0 Then intIn = InStr(1, Item.Subject, "file")
        If intIn = 0 Then intIn = InStr(1, Item.Subject, "enclosed")
        
        '
        intAttachCount = Item.Attachments.Count
        If intIn > 0 And intAttachCount <= intStandardAttachCount Then
            m = MsgBox("There is no attachment." _
                & vbNewLine & vbNewLine & _
                "Do you still want to send this message? ", _
                vbYesNo + vbExclamation, "Microsoft Office Outlook")
            If m = vbNo Then
                Cancel = True
                GoTo ExitSub
            End If
        End If
    '
    'CHECK #3: Check for meeting requests with no location
    If Item.Class = olMeetingRequest Then
        If InStr(1, Item.Body, "Where:", vbTextCompare) = 0 Then
            m = MsgBox("The meeting location is blank... " _
                & vbNewLine & vbNewLine & _
                "Do you still want to send this meeting invite? ", _
                vbYesNo + vbExclamation, "Microsoft Office Outlook")
            If m = vbNo Then
                Cancel = True
                GoTo ExitSub
            End If
        End If
    End If
    'Last check
    If MsgBox("Have you included everybody you need to?", vbYesNo + vbExclamation, "Microsoft Office Outlook") <> vbYes Then
        Cancel = True
    End If
    '
ExitSub:
    Set Item = Nothing
    strBody = ""
    Exit Sub
    '
ErrorHandler:
    MsgBox "Send Checker" & vbCrLf & vbCrLf _
        & "Error Code: " & Err.Number & vbCrLf & Err.Description
    Err.Clear
    GoTo ExitSub
End Sub

Open in new window

David Lee

Hi, Ed.

Microsoft has not exposed spell checking to Outlook's object model. There isn't a spell check property or method that we can turn off and on to accomplish this. I see two possible solutions, both kludges, and one of them may not work at all.

1. Configure Outlook to not normally spell check items before sending. Check items as they are sent for the four digit code. If we find it in the message, then do nothing. Otherwise, run a spell check by simulating mouse clicks on the menu.

2. The option to spell check is stored as a value in the registry. Leave Outlook configured to spell check all outbound items. As above, check items as they're sent for the four digit code. If it's not there, do nothing (Outlook will spell check the item). If the code is there, then change the registry setting to avoid a spell check, let the send complete, then change the registry setting to re-enable spell checking. I'm not sure this approach will work.

edmacey

ASKER

Thanks BlueDevilFan,

I think I might have achieved it, all i wanted was for the last check of that code not to be displayed when my automatic emails were sent. I have put the 4 digit code into their body of 4501 and ammended check 4 to be as below. I will close and award you the points as I'm often not confident enough to see the answer myself. Final question though, is the code below a good way of doing it or can you see a better way?

Thanks Ed.

'Check #4: Last check, have you included everybody - won't ask for check if message contains 4 digit code 4501
    If InStr(strBody, "4501") = 0 Then
        If MsgBox("Have you included everybody you need to?", vbYesNo + vbExclamation, "Microsoft Office Outlook") <> vbYes Then Cancel = True
    Else
    End
    End If

Open in new window

ASKER CERTIFIED SOLUTION

David Lee

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

edmacey

ASKER

Thank you so much. Ed.

David Lee

You're welcome, Ed.