get paid to paste

Outlook Customized Mistake Script

' 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

Pasted: Mar 8, 2024, 4:50:10 pm
Views: 163