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

  • Article

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.
Msg.DataSource.Save
    EventStatus = cdoRunNextSink
End Sub