Marc's Musings

Below is code to create an automated response whenever someone sends a message to a now obsolete mail file.

It can also be used for a “live” mailbox to indicate something like “We’ve received your message and will respond in 24 hours.”

The only requirements are that the Person document (or mail-in document) must still be present in the directory and a valid name is used in the “Run on Behalf of” field of the agent properties.

Usually this is done for someone who is no longer with the company and so is already in the “Deny Access” groups so using the mailfile owner’s name is often not an option.

It is set up to respond to EVERY message sent to it (unlike the Out of Office Agent) to assure the sender that there message HAS been received.

This particular variation was developed after someone with an autoresponder sent a message to one of our autoresponder  mailboxes and ended up with an endless loop. Messages with identical sender and subject will receive only 1 response per day.

Make sure you customize everything in the agent below that has been bolded.

Agent Information
Name:    Autoresponder – Ensure Unique
Last Modification:    01/03/2008 04:39:40 PM
Comment:    [Not Assigned]
Shared Agent:    Yes
Type:    LotusScript
State:    Disabled
Trigger:    Before New Mail Arrives
Acts On:    Each incoming mail document
LotusScript Code:

Option Public
Option Declare

‘This autoresponder will protect against responses from *other* autoresponders by
‘checking to see if we’ve already received a message from them with the same subject already that day.
‘see the “IsMessageUnique” logic for details
‘Also checks for $AssistMail field which indicates that the message was sent by some
‘automated process. This comes from the case where someone sent a message FROM
‘this inbox TO this inbox and started an endless loop.
‘Note also that there is a name in the “Run on Behalf of” field on the security tab.
‘If this field is populated it *must* be represented in the ACL (At least Reader, probably author is safer) or you
‘will get weird errors when the agent runs.

Sub Initialize
    Dim sess As New NotesSession
    Dim docNotify As NotesDocument
    Dim docCur As NotesDocument
    Dim sPrintText As String
    Dim sMessage As String
    Dim sSendTo As String
    On Error Goto ErrGeneral
    On Error 4294 Goto ErrBadAddress
    Set docCur = sess.DocumentContext
    If Not docCur Is Nothing Then
        If Not Lcase$(docCur.Form(0)) = “nondelivery report” Then  ‘Don’t bother for failed delivery reports
            ‘Only internet messages
        ‘    If docCur.hasitem(“SMTPOriginator”)  Or docCur.hasitem(“MIME_Version”) Or docCur.hasitem(“$MIMETrack”) Then
            If Not docCur.HasItem(“$AssistMail”) Then ‘isn’t sent by another agent
                If IsMessageUnique(docCur) Then
                    Gosub ResponseMessage
                End If
            End If
        ‘    End If
        End If
    End If
LeaveSub:
    Exit Sub

ResponseMessage:
    Gosub SetupMessage
    Set docNotify = sess.CurrentDatabase.CreateDocument
    docNotify.SaveMessageOnSend = False
    docNotify.Form = “Memo”
    If Not docCur.ReplyTo(0)=”” Then
        sSendTo = docCur.ReplyTo(0)
    Else
        sSendTo = docCur.From(0)       
    End If
    docNotify.SendTo = sSendTo
‘Do not need the following fields since this is to be signed by the database owner.
‘if we ever change the signer to “Automail” then these should be set up properly
‘    docNotify.Principal=
‘    docNotify.ReplyTo=
    docNotify.Subject = “re: ” & docCur.subject(0)
    docNotify.Body = sMessage
    Call docNotify.Send(False)
    docCur.EFXResponded= Now
    Call docCur.Save(True,False)
    Return

SetupMessage:
    sMessage= “This is no longer a valid email address for John Doe.  ” &_
    “If you would like you may contact him at john.doe@gmail.com, phone – 555-555-5555.“& Chr$(13) & Chr$(13)
    Return

ErrBadAddress:
    Resume LeaveSub

ErrGeneral:
    sPrintText=    “Error: ” + Cstr(Err) + ” defn: ” + Error$ +  “.  Aborting Agent”
    Call ProblemNotify(sPrintText)   
    Resume LeaveSub
End Sub

Function IsMessageUnique(docCur As NotesDocument) As Boolean
    ‘Check to see if document is the only one with this sender and subject. If so return True
    ‘Otherwise, return false. We expect that multiple messages in a day from the same source with the same subject are probably
    ‘automated responses.
    ‘We only look at the most recent day’s worth of documents, if this doc is for a new day, great,
    ‘or if no match is found for the current day, also great
    Dim sess As New notessession
    Dim viewInbox As NotesView
    Dim docChk  As NotesDocument
    Dim docComp As notesdocument
    Dim bAscending As Boolean
    Dim datRcvd As  Notesdatetime
    Dim datDoc As NotesDateTime
    Dim datComp As NotesDateTime
    IsMessageUnique=True
    Set viewInbox =sess.CurrentDatabase.GetView(“($Inbox)”)
    If viewInbox Is Nothing Then  ‘Returns false
        IsMessageUnique=False
        Exit Function   
    End If
    Set docChk = viewInbox.GetFirstDocument
    Set datDoc = New NotesDateTime(docChk.Created)
    Set docComp= viewInbox.GetLastDocument
    Set datComp = New NotesDateTime(doccomp.Created)
    If datDoc.TimeDifference(datComp) > 0 Then ‘First Document is older than last document, sorted in Descending order
        bAscending = False
    Else
        bAscending = True
    End If
    Set datRcvd = New NotesDateTime(docCur.Created)  ‘get created date from newly received document
    Call datRcvd.SetAnyTime
    If bAscending Then
        Set docChk = viewInbox.GetLastDocument
    Else
        Set docChk = viewInbox.GetFirstDocument
    End If
    While Not docChk Is Nothing
        Set datDoc = New NotesDateTime(docChk.Created)
        Call datDoc.SetAnyTime
        If Not datDoc.TimeDifference(datRcvd) = 0 Then ‘not sent on same date – either new day or have reached previous day
            IsMessageUnique=True
            Exit Function
        End If
        If docChk.From(0) = docCur.From(0) Then ‘Match, might not be not unique, check subject.
            If docChk.Subject(0) = docCur.Subject(0) Then ‘Match, definitely not unique, end now.
                IsMessageUnique=False
                Exit Function
            End If
        End If
        If viewInbox Is Nothing Then  ‘Returns false
            IsMessageUnique=False
            Exit Function   
        End If
        If bAscending Then
            Set docChk = viewInbox.GetPrevDocument(docChk)
        Else
            Set docChk = viewInbox.GetNextDocument(docChk)
        End If
    Wend
End Function
Sub ProblemNotify(sPrintText As String)
    Dim sess As New NotesSession
    Dim db As NotesDatabase
    Dim docProblem As NotesDocument
    Dim item As NotesItem
    If sess.isonserver Then ‘send an e-mail or print to Log   
        Set db = sess.currentdatabase
        Set docProblem = db.CreateDocument       
        Set Item = docProblem.ReplaceItemValue(“Form”,”Memo”)
        Set Item = docProblem.ReplaceItemValue(“SendTo”,”Your Default Notification Mailbox“)
        Set Item = docProblem.ReplaceItemValue(“Principal”,sess.currentagent.name & ” Agent”)
        Set Item = docProblem.ReplaceItemValue(“Subject”,”Error: ” & db.Title & ” DB – ” & sess.currentagent.name & ” Agent”)       
        Set Item = docProblem.ReplaceItemValue(“Body”,”On ” & db.server & “!!” &db.filepath & Chr$(13) & Chr$(13) & sPrintText)
        Call docProblem.Send(False)
    Else
        Print sPrintText
        Messagebox sPrintText,0,”Problem with ” & sess.currentagent.name & ” Agent”
    End If
End Sub

Powered by ScribeFire.

I wanted to be able to get the url for the current document(s) in my mail database so I could paste them in another application and then click on the URLs to access the original messages directly from within that other app as needed.

I cobbled together a little LotusScript agent that grabs the NotesURL from each document and then scrubs out that junk that Lotus includes for no discernible reason.

So

notes://NotesServer@mydomain/__85256EDA00695075.nsf/0/EEF8D00A7E50A458852573BE0069A402?OpenDocument

becomes

notes://NotesServer/85256EDA00695075/0/EEF8D00A7E50A458852573BE0069A402?OpenDocument

This script will show the result in a messagebox. I also have it insert the URL into the clipboard for me but I’ve scraped that out so as not to confuse the issue.

It’s not as pretty as I’d like, but this should help others trying to get a useful URL out of Lotus’ terrible implementation.

Dim sess As New NotesSession
Dim doc As NotesDocument
Dim coll As NotesDocumentCollection
Dim sTempURL As String
Dim sURL As String
Dim iPosAT As Integer
Dim iPosSlashUnderscores As Integer
Dim iPosNSF As Integer

Set coll = sess.CurrentDatabase.UnprocessedDocuments
Set doc = coll.GetFirstDocument

sURL = “”
While Not doc Is Nothing
    sTempURL = doc.NotesURL
    iPosAT=Instr(sTempURL,”@”)
    iPosSlashUnderscores = Instr(sTempURL,”/__”)
    iPosNSF = Instr(iPosSlashUnderscores+1,sTempURL,”.nsf/”)
    If sess.CurrentDatabase.Server=”” Then
        sTempURL = Left$(sTempURL,8) & “/” & Mid$(sTempURL,iPosSlashUnderscores+3,iPosNSF-iPosSlashUnderscores-3) & Mid$(sTempURL,iPosNSF+4)
    Else
        sTempURL = Left$(sTempURL,iPosAT-1) & “/” &    Mid$(sTempURL,iPosSlashUnderscores+3,iPosNSF-iPosSlashUnderscores-3) & Mid$(sTempURL,iPosNSF+4)
    End If

    sURL = sURL & sTempURL
    Set doc = coll.GetNextDocument(doc)
    If Not doc Is Nothing Then
        sURL = sURL & Chr$(13)
    End If
Wend
If sURL = “” Then
    Messagebox “No Documents Selected”,0,”Nothing to do”
Else
    Messagebox sURL,0,”URL(s) for selected docs”
End If

(also posted in http://www-10.lotus.com/ldd/nd6forum.nsf/ShowMyTopicsAllFlatweb/9324f9e90784fbd5852573be0071f311?OpenDocument)