Control email forwarding, avoid spam loop

This tip on forwarding e-mails to another account will prevent users from getting caught in a spam loop. I used a profile to store the forwarding address. This allows the end user to control the forwarding function by simply providing or deleting a forwarding address. I used an external function Implodes from my library which provides the same functionality in LotusScript as @Implode. This is necessary if your users have a client earlier than R6. I added the addressing information to the bottom of the Body field and deleted it from the original fields.

Code

Sub Initialize
      Dim session As NotesSession
      Dim db As notesdatabase
      Dim docMail As notesdocument
      Dim doc As NotesDocument
      Dim docProfile As NotesDocument
      Dim cAddress As String
      Dim rtItem As Variant

      Set session = New NotesSession
      Set db = session.CurrentDatabase
      Set docProfile = db.Getprofiledocument("EmailProfile")
      If docProfile Is Nothing Then Exit Sub
      cAddress = docProfile.EmailForwardTo(0)
      If cAddress = "" Then Exit Sub

      Set doc = session.DocumentContext
      Set docMail = New NotesDocument( db )

      doc.CopyAllItems docMail, True
      docMail.From =  doc.From(0)
      docMail.Principal =  doc.From(0)

      Set rtItem = docMail.GetFirstItem( "Body" )
      rtItem.AddNewLine 2
      rtItem.AppendText "From: 
" & Implodes( docMail.From, "," )
      rtItem.AddNewLine 1
      rtItem.AppendText "To: 
" & Implodes( docMail.SendTo, "," )
      rtItem.AddNewLine 1
      rtItem.AppendText "Cc: 
" & Implodes( docMail.CopyTo, "," )

      docMail.SendTo = cAddress
      docMail.CopyTo = ""
      docMail.BlindCopyTo = ""
      docMail.Send True
End Sub

Public Function Implodes
(sVals As Variant, delim As String) As String
    'Concatenate the values 
of the array into a single string
      On Error Goto ErrHandle
      Dim tstr as String
      If Isempty( sVals ) Then
            Implodes = ""
            Exit Function
      End If
      tstr = ""
      If Isarray( sVals ) Then
            For i = Lbound( sVals ) To Ubound(sVals)
                  If tstr <> "" Then tstr = tstr & delim
                  tstr = tstr + Cstr( sVals(i) )
            Next
      Else
            tstr= Cstr( sVals )
      End If

     'Return the imploded string
      Implodes = tstr
      On Error Goto 0
      Exit Function
ErrHandle:
      ...

End Function

Do you have comments on this tip? Let us know.

This tip was submitted to the SearchDomino.com tip exchange by member Gary Willert. Please let others know how useful it is via the rating scale below. Do you have a useful Notes/Domino tip or code to share? Submit it to our monthly tip contest and you could win a prize and a spot in our Hall of Fame.

Rate this Tip To rate tips, you must be a member of SearchDomino.com. Register now to start rating these tips. Log in if you are already a member. Submit a Tip Digg This!     StumbleUpon     Del.icio.us    RELATED CONTENT Agent Run or restart Notes/Domino agents via text messages Approve Lotus Notes documents using a BlackBerry mobile device LotusScript agent indexes Lotus Notes/Domino databases Open documents in Lotus Notes from the Web without a UNID Fix and update Lotus Notes documents with limited access Verify scheduled agent status with Domino Extensible Language (DXL) How to export data from a Lotus Notes database to a CSV file Enable or disable scheduled agents without opening the Lotus Notes database design Creating custom views in Lotus Notes databases Editing fields in a Lotus Notes view with Ajax LotusScript LotusScript finds the first occurrence of a string from the right Clear Recent Contacts view and prevent repopulation in Lotus Notes 8.x Search Microsoft Active Directory with LotusScript Three steps to trap and handle save conflicts with LotusScript Troubleshoot agents by displaying LotusScript variables online LotusScript sorts lists alphabetically Run or restart Notes/Domino agents via text messages LotusScript code rebuilds corrupted busytime.nsf file Soft-code item names to facilitate LotusScript management LotusScript agent automates selective mail file replication Lotus Notes Domino Antispam Software and Spam Filtering LotusScript agent moves tagged spam email to junk mail folder Limit the size of incoming email attachments to a Lotus Domino server Stop spam on BlackBerry mobile devices Online crime as ugly as ever Putting a stop to incoming spam on Lotus Notes 6.5 Image-based spam scams on the rise Image spam paints a troubling picture McAfee products vulnerable to code execution flaw A recipe for secure IM success How to protect Lotus Domino Server from spam blacklists RELATED RESOURCES 2020software.com, trial software downloads for accounting software, ERP software, CRM software and business software systems Search Bitpipe.com for the latest white papers and business webcasts Whatis.com, the online computer dictionary DISCLAIMER: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.