Notes/Domino 4 and 5 Forum

Hi All,

I have a problem with my action button script.

Actually every thing is working fine Except the while loop. For a single document its working fine. If 2 or more documents is there means, the routing process is working till the last document. And then its throwing some error like this :

"Document is not from this collection."

Actually if 2 documents are there in the collection, both the documents are routing to the recipients. But why its throwing this error....

And also i find that some times this loop is going endless till i use CTRL+BREAK...

Pls go thru with my script below and gimme some suggestions...


Sub Click(Source As Button)

Dim session As New NotesSession
Dim doc As NotesDocument
Dim doc1 As NotesDocument
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim rtitem, rtitem1 As NotesRichTextItem
Dim maildoc As NotesDocument
Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim unid As String
Dim view As NotesView
Dim username As String

Set db = session.CurrentDatabase

username = session.CommonUserName

Choices = Evaluate(|@Unique(@Text(@DbLookup( "" : "NoCache" ; "" ; "EmbView" ; "| & username & |"; 2))) |)

Dim Selection As Variant

Selection = workspace.Prompt(PROMPT_OKCANCELLIST, "Select Batch Number", "Select Batch Number from the List", PROMPT_LISTMULT, Choices)

If Selection = "" Then
Msgbox "No Batch Number is selected. Please select the Batch Number.", 0+32, "Select Batch Number"
Exit Sub
End If

Dim dateTime As NotesDateTime

Set dateTime = New NotesDateTime(Created)

Dim ss1 As String

ss1 = Cstr(username + "-" + Selection)

If Selection <> "" Then

Set view = db.GetView("EmbView1")
Set dc = view.GetAllDocumentsByKey(ss1)

End If

If dc.Count = 0 Then
Messagebox "Sorry no Documents were found that met search criteria.", 0 + 64, "Email Merge"
Exit Sub
Else

msg = Msgbox ("Selected Batch Number : " & Selection & ". " & dc.Count & "document(s) will be sent out to the recepients. Are you sure want to continue?", 1 + 32, "Sending Message")

End If

If msg = 2 Then
Exit Sub
Else

Set doc = dc.GetFirstDocument

unid = doc.UniversalID

If Not doc Is Nothing Then
While Not doc Is Nothing

Dim item As Variant
Set item = doc.GetFirstItem("Body")
Call doc.Save(True, False)
Set maildoc = New NotesDocument(db)
maildoc.Form = "Memo"
maildoc.SendTo=doc.ToList
maildoc.CopyTo=doc.CCList
maildoc.BlindCopyTo=doc.BCCList
maildoc.Subject = doc.Subject
maildoc.BatchNo = doc.BatchNo
maildoc.DisplayFrom=doc.SenderName

Set rtitem1 = doc.GetFirstItem("Body")

Dim rtpStyle As NotesRichTextParagraphStyle
Set rtpStyle = session.CreateRichTextParagraphStyle
Set rtitem = New NotesRichTextItem(maildoc, "Body")
rtpStyle.InterLineSpacing = SPACING_DOUBLE
Call rtitem.AppendParagraphStyle(rtpStyle)
Call rtitem.AppendRTItem(rtitem1)
Call rtitem.addTab(5)
Call rtitem.AddNewLine(2)

Call maildoc.send(False)

Set doc = db.GetDocumentByUNID(unid)
Call doc.ReplaceItemValue("SentDate", Date$ + " " + Time$)
Call doc.Save(True, False, True)

Set doc = dc.GetNextDocument(doc) 'Throwing the error in this line after gone thru with all the document collection
Wend
End If
End If

Call workspace.ViewRefresh

End Sub


Thanks
Suresh