' Ensure all variables are explicitly declared Option Explicit ' This subroutine is triggered just before an email is sent. Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) ' Create a collection to hold the list of typos from a text file. Dim typosList As Collection ' Load the mistakes/typos from a specified text file into the collection. Set typosList = LoadTyposFromTXT("D:\Outlook\typos.txt") ' Declare a variable to reference the mail item. Dim msg As MailItem ' Check if the item being sent is a mail item. If TypeName(Item) = "MailItem" Then ' Cast the Item to a MailItem object. Set msg = Item ' Declare a string variable to hold the message about found mistakes/typos. Dim foundTyposMsg As String ' Check for typos in the mail item's body using the loaded mistakes/typo list and store any findings. foundTyposMsg = CheckForTypos(msg, typosList) ' If any typos were found, execute the following block. If foundTyposMsg <> "" Then ' Declare a variable to capture the user's response from the message box. Dim response As VbMsgBoxResult ' Display a message box to the user indicating potential mistakes/typos and asking whether to send the email. response = MsgBox("Potential mistakes or typos were found in your email: " & vbCrLf & foundTyposMsg & vbCrLf & "Do you still want to send the email?", vbYesNo + vbQuestion, "Check Before Sending") ' If the user chooses 'No', cancel the send operation. If response = vbNo Then Cancel = True ' Cancel sending End If ' If the user clicks Yes, the email is sent as normal (no additional code needed here). End If End If End Sub ' This function loads a list of typos from a specified text file. Function LoadTyposFromTXT(filePath As String) As Collection ' Create a new Collection object to hold the mistakes/typos. Dim typosList As New Collection ' Declare a variable to hold a file number. Dim fileNumber As Integer ' Temporary variable to hold each line read from the file. Dim line As String ' Get a free file number. fileNumber = FreeFile ' Open the specified file for reading. Open filePath For Input As #fileNumber ' Loop until the end of the file is reached. Do While Not EOF(fileNumber) ' Read a line from the file. Line Input #fileNumber, line ' Add the line (a mistake, grammar error, or typo) to the collection. typosList.Add line Loop ' Close the file. Close #fileNumber ' Return the collection of typos. Set LoadTyposFromTXT = typosList End Function ' This function checks a mail item for any mistakes/typos based on the provided collection of typos. Function CheckForTypos(mailItem As MailItem, typosList As Collection) As String ' Initialize a string to accumulate found typos. Dim foundTypos As String foundTypos = "" ' Temporary variable for iterating over the collection of typos. Dim typo As Variant ' Iterate over each typo in the collection. For Each typo In typosList ' If the mistake/typo is found in the mail item's body, append it to the string of found mistakes/typos. If InStr(1, mailItem.Body, typo, vbTextCompare) > 0 Then ' Add a comma separator if it's not the first mistake/typo found. If foundTypos <> "" Then foundTypos = foundTypos & ", " End If ' Append the found mistake/typo to the string. foundTypos = foundTypos & "'" & typo & "'" End If Next typo ' If any mistakes/typos were found, prepend the message with "Suspected Issues - you can change this: ". If foundTypos <> "" Then foundTypos = "Suspected issues: " & foundTypos End If ' Return the message about found mistakes/typos. CheckForTypos = foundTypos End Function