Can any body help me with this error? I don't have a debugger at home and someone ask me for help for this auto reply lotus script Thanks in advance masters :)
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 an auto reply” &_
“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
waiting for your resonse. thanks a lot
The comment marks and strings are wrong:
'This is a comment
`Do Not need - not a comment
‘if we ever - not a comment
string1 = "ok"
string2 = “not ok”
The code looks like it was processed with a text beautifier, if you can't get the original you can fix it by replacing curly quotes with straight ones, either with search&replace (` -> ', ‘ -> ', “ -> ", ” -> ") or manually.
Your code:
...
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
...
Corrected:
...
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
...