Hello, I have a survey database that I use to generate surveys for users and/or groups selected from the company NAB. My difficulty is this, duplicates are being sent.How do I prevent a survey being sent to someone who has already received a copy? The user name may be listed in more than one nested distribution group. The ‘SurveysByEmployeeName’ view mentioned in the code below uses the criteria “Survey Form and Status = Sent”.
Also, when generating the surveys, I get error ‘NO RESUME’ and I cannot figure out where the code is wrong. If anyone would mind taking a look at the code which is shown below and giving me any advice, I would be grateful.
Thank you.
Sub Click(Source As Button)
%REM
this sub creates an unique array of names based on groups or individual names given.
Since groups can be nested, it does a recursive call to the function FindGroup to create the list.
The list is used to create Survey Documents and Mail a notice to the end user asking them to
complete the survey. The SurveySender form will be saved with the time surveys sent stamped
%END REM
Dim ws As New Notesuiworkspace
Dim uidoc As NotesUIDocument
Dim doc As notesdocument
Dim session As New NotesSession
Dim nameplace As notesname
Dim db As notesdatabase
Dim groupview As NotesView
Dim PeopleView As NotesView
Dim dateTime As New NotesDateTime( "" )
Dim arr1() As String
Dim SendList () As String
Dim zzz As Variant
Dim groupdoc As notesdocument
Dim groupitem As notesitem
Dim item As notesitem
Dim results As Variant
Dim nameitem As NotesItem
Dim counter As Integer
Set uidoc = ws.CurrentDocument
Call uidoc.Refresh
Set doc = uidoc.Document
Set db = session.CurrentDatabase
Dim currentLog As NotesLog
Set currentLog = New NotesLog ( "Survey Sender" + " Agent in " + db.Title + " on " + db.Server )
Call currentLog.OpenNotesLog( db.Server, "\suppdesk\agentlog.nsf" )
Dim addbook As New notesdatabase(db.Server, "Names.nsf")
Set groupview = addbook.GetView("Groups")
Set PeopleView = addbook.GetView("($NamesFieldLookup)")
dateTime.LSLocalTime = Now
Redim Preserve Arr1(x)
Redim SendList (0)
' save the surveysender doc
Call doc.Save(True, False)
'create a richtext field to hold the array in
Dim item2 As New notesrichtextitem(doc,"SentList")
'get the list of names to send survey to
Set item = doc.GetFirstItem("SurveyRecipients")
'loop through all names to build unique array
Forall v In item.Values
'call to function (recursive) Which will return either one name
'or an array of names if v is a group name.
zzz = findgroup(db , v , groupview , doc , datetime, 0, Arr1 )
'build the array containing all the names. (append to the end)
For z=0 To Ubound(zzz)
temp = Ubound(sendlist) +1
Redim Preserve sendlist (temp)
sendlist(temp) = zzz(z)
Next
End Forall
arr3 = Arrayunique(SendList) 'array to hold unique values so we don't send two to the same person
For counter = 1 To Ubound(arr3) '1st element is null
'this sub will create the surveys and send the email
Call createandsend(db,arr3(counter), doc, datetime, PeopleView, currentlog)
Next
'save the surveysender document with
doc.surveySent = Now
Call doc.Save(True, False)
doc.saveoptions = "0"
Call uidoc.Reload
Call uidoc.close
Messagebox Cstr(Ubound(arr3)) + " Names"
Call currentLog.Close
End Sub
Function findgroup(db As notesdatabase, v As Variant, groupview As notesview, doc As notesdocument, datetime As NotesDateTime, x As Integer, arr1 As Variant) As Variant
Dim groupdoc As notesdocument
Dim groupitem As notesitem
Dim nam As notesname
Set groupdoc = groupview.getdocumentbykey(v, True)
If groupdoc Is Nothing Then
Set nam = New NotesName(v)
Redim Preserve Arr1(x +1)
Arr1(x +1) = Cstr(nam.common)
Else
Set groupitem = groupdoc.GetFirstItem("Members")
Forall r In groupitem.values
Call findgroup(db, r, groupview, doc, datetime, Ubound(Arr1), Arr1)
End Forall
End If
findgroup = Arr1
End Function
Sub createandsend(db As NotesDatabase, v As String , doc As notesdocument, datetime As notesdatetime, PeopleView As notesview, currentlog As noteslog)
On Error Goto NoPeep
Dim logmsg As String
logmsg = ""
Dim peepdoc As notesdocument
Dim existingview As notesview
Set existingview = db.GetView("(SurveysByEmployeeName)")
Dim memo As notesdocument
Dim surveydoc As NotesDocument
Dim variableName As New NotesName(v )
Set peepdoc = PeopleView.getdocumentbykey(variablename.common)
Set surveydoc = existingview.getdocumentbykey(variablename.common)
If peepdoc Is Nothing Or Not (surveydoc Is Nothing) Then
If peepdoc Is Nothing Then
logmsg = "Name not in address book"
End If
If Not (surveydoc Is Nothing) Then
logmsg = "Survey already exists"
End If
Goto NoPeep
Else
'continue
End If
Set surveydoc = db.CreateDocument
surveydoc.form = doc.surveyform(0)
surveydoc.QuarterEnd = doc.QuarterEnd(0)
surveydoc.name = variableName.Common
Set nameitem = surveydoc.GetFirstItem("name")
nameitem.IsAuthors = True
surveydoc.status = "Sent"
surveydoc.surveysent = datetime.DateOnly
Call surveydoc.save(True, False)
Set memo = db.CreateDocument
Memo.subject = doc.subject(0)
Memo.Principal = doc.principal(0)
memo.replyto = doc.replyto(0)
Dim rtitem As New notesrichtextitem(memo, "body")
Call rtitem.appendtext(doc.body(0))
Call rtitem.addnewline(2)
Call rtitem.Appenddoclink(surveydoc, "","Only for: / Solamente para: / Seulement pour: / Nur für: / Somente para: Lotus Notes users - click here to open the form")
Call rtitem.addnewline(2)
Call rtitem.appendtext("iNotes users, click the weblink shown below to open the form.")
Call rtitem.addnewline(1)
Dim url As String
filepathStr = Replace(db.FilePath, {\}, {/})
url = "http://my server.com/"+ filepathStr+"/bydocid/"+ surveydoc.UniversalID+ "?EditDocument"
Call rtitem.AppendText ( url )
Call memo.send(False, v)
logmsg = "Sent to user"
NoPeep:
If logmsg = "" Then
logmsg = "Error processing"
End If
Call currentLog.LogError ( 0, v + " " + logmsg)
End Sub