Categorised Menu List

thisMail_BeforeDelete Event works just before the mail is being deleted

The fact is: this code is part of a project, where, each outgoing and incoming mail is to be monitored.  This will help us understand, as to how many times a mail is being responded for the same query.

 

Context: 

Every outgoing mail is to be captured into a database without the body of the mail as it may contain customer sensitive data.

 

How it works: 

When the user clicks on the Delete Button on the outlook mail box, this code is triggered.  Respective data will be sent to database for further analysis.

    BEFORE MAIL DELETE EVENT

    WORKS JUST BEFORE MAIL IS DELETED

    Private Sub thisMail_BeforeDelete(ByVal Item As Object, Cancel As Boolean)

    Dim strFrom As String, strSubject As String, strTo As String, strCC As String, strBCC As String
    Dim strRefNo As String, strAttNames As String
    Dim intAttachs As Integer, i As Integer

    'If thisMail.Class = olMail Then
    '    strFrom = thisMail.SenderName
    '    strSubject = thisMail.Subject
    '    strTo = thisMail.To
    '    strCC = thisMail.CC
    '    strBCC = thisMail.BCC
    '    'strMailType = thismail.SenderEmailAddress
    'End If

    If Item.Class = olMail Then
        strFrom = Item.SenderName
        strSubject = Item.Subject
        strTo = Item.To
        strCC = Item.CC
        strBCC = Item.BCC
        intAttachs = Item.Attachments.Count
                
        For i = 1 To intAttachs
            strAttNames = Item.Attachments.Item(i).DisplayName & ", " & strAttNames
        Next
    End If

    If MsgBox("You are about to delete the message from " & UCase(strFrom) & vbCrLf & _
    "Do you confirm your action to DELETE...?" & vbCrLf & vbNewLine & _
    "Note that this action is monitored...", vbYesNo + vbQuestion + vbDefaultButton2, "Delete...?") = vbNo Then Cancel = True

    strRefNo = strSubject
    If InStr(strSubject, "mRNo") > 0 Then
        strRefNo = Mid(strSubject, InStr(strSubject, "mRNo"), 18)
    Else
        strRefNo = "No RefNo"
    End If

    openRecSet
        If rstPostData.State = adStateClosed Then rstPostData.Open "tblWorkData", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    '    prcUpdateData rstPostData
            With rstPostData
                .AddNew ' create a new record
                    rstPostData.Fields(1).Value = strFrom
                    rstPostData.Fields(2).Value = Environ("computername")   'should be replaced with NBCU ID
                    rstPostData.Fields(4).Value = strRefNo
                    rstPostData.Fields(5).Value = "Delete"                    ' actions such as reply, replyall, forward, close, reject, others.
                    rstPostData.Fields(6).Value = Left(strTo, 255)
                    rstPostData.Fields(7).Value = Left(strCC, 255)
                    rstPostData.Fields(8).Value = Left(strBCC, 255)
                    rstPostData.Fields(9).Value = Left(strSubject, 255)
                    rstPostData.Fields(11).Value = intAttachs
                    rstPostData.Fields(12).Value = Left(strAttNames, 255)
                    rstPostData.Fields(13).Value = Date
                    rstPostData.Fields(23).Value = Now
                .Update ' stores the new record
            End With
    End Sub
     

     

    Private Sub openRecSet()
    Dim strDBPath As String
        strDBPath = "D:\Users\DefaultUser\abcGmb.mdb"    '~~~~~~~~~~~~~~ connect to the Access database
        Set cn = New ADODB.Connection
        cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source = " & strDBPath & ";"         '~~~~~~~~~~~~~ open
        Set rstPostData = New ADODB.Recordset
    End Sub

    Issues you may encounter: While you copy and paste the code from here to code window, replace double quotes in code window again, as these quotes will appear as smart quotes.

     

    I am publishing with a pure intension to help, as the resources on Outlook are very scarce.,

    I had to try very hard to even to get very little help.,  All the code is functional at my end, and I respect every sort of disclaimer, explicitly, I dont take any responsibility what so ever.

    Most of the Outlook Code that I post here will connected to Access Database, only then, we can monitor