Monitoring event sink # 16 – Sample for adding disclaimers for outgoing SMTP messages – Visual Basic 6.0

Visual Basic 6.0 sample

Dim TextDisclaimer As String
Dim HTMLDisclaimer As String

Implements IEventIsCacheable
Implements CDO.ISMTPOnArrival

Private Sub IEventIsCacheable_IsCacheable()
    'Just returns S_OK.
End Sub

Private Sub Class_Initialize()
  'TODO: Replace the sample disclaimer text with your own text.
  TextDisclaimer = vbCrLf & "DISCLAIMER:" & vbCrLf & "Sample Disclaimer Text."

  HTMLDisclaimer = "<p></p><p>DISCLAIMER:<br>Sample Disclaimer Text"
End Sub

Private Sub ISMTPOnArrival_OnArrival(ByVal Msg As CDO.IMessage, EventStatus As CDO.CdoEventStatus)
    If Msg.HTMLBody <> "" Then
        Dim szPartI As String
        Dim szPartII As String
        Dim pos As Integer
        'Search for the "</body>" tag and insert the disclaimer before that tag.
pos = InStr(1, Msg.HTMLBody, "</body>", vbTextCompare)

        szPartI = Left(Msg.HTMLBody, pos - 1)
        szPartII = Right(Msg.HTMLBody, Len(Msg.HTMLBody) - (pos - 1))
        Msg.HTMLBody = szPartI + HTMLDisclaimer + szPartII
    End If

    If Msg.TextBody <> "" Then
        Msg.TextBody = Msg.TextBody & vbCrLf & TextDisclaimer & vbCrLf
    End If
    'Commit the content changes to the transport ADO Stream object.

    EventStatus = cdoRunNextSink
End Sub

Skip to main content