The sample functions below contain functionality needed to take the "current" document and send or forward it similarly to @Forward @Command or the UIDocument.Forward method.
The plus with these functions, is that they do not require a mail file. The first is written for front-side, current document forwarding. The second is meant to be kicked off via agent/link on the web. The first one can work from the web if the uiworkspace components are switched to back-end, and the pop-up selection w/in the click sub is replaced with some other graphical interface (GUI) that brings back the list.
Solution 1:
This version of a forward function, forwards the current opened document by clicking a Forward or Send button on the current document when in read mode.
Options
Option Declare
Sub Click(Source As Button)
Dim s As New NotesSession
Dim w As New NotesUIWorkspace ' needed for picklist
Dim db As NotesDatabase ' current db
Dim uiDoc As NotesUIDocument ' current doc front-end
Dim doc As NotesDocument ' current doc
Dim sendtoLst As Variant ' array of string values of names selected in picklist for sendto values
Dim newssearchstr As String ' search string for newsCol to get 0 docs
Dim newsCol As NotesDocumentCollection ' collection to hold the current document ultimately, so we can make a forward of the doc
Dim msubject As String ' subject field of mDoc
Dim mreplyto As String ' reply to e-mail of mDoc
' update custom variables below
msubject = "put custom subject here"
mreplyto = "mye-mailaddress@mydomain.com"
' ________________________
' setup environment
Set db = s.CurrentDatabase
Set uiDoc = w.CurrentDocument
Set doc = s.DocumentContext
If (doc Is Nothing) Then
' get via uiDoc
Set doc = uiDoc.Document
End If
If (doc Is Nothing) Then
' could not get doc - has it been saved?
Print "Aborted. Could not get the current saved document. Has document been saved?"
Exit Sub
End If
' get list of names for SendTo
sendtoLst = w .PickListStrings(0, True ) ' PICKLIST_NAMES (0)
' check the list
If ( Isempty( sendtoLst ) ) Then
' abort, done
Messagebox "Canceled" , , "No names selected"
Exit Sub
Else
' create newsletter collection
newssearchstr = {Form = "asdfasdf12535asdf" } ' bogus search just to get empty collection
Set newsCol = db .Search( newssearchstr , Nothing , 1 )
If (newsCol.Count>0) Then
' error, search should not return anything
Print "Cancelled. Starting forward collection not empty for forward (newsletter)."
Exit Sub
End If
' add the current doc to collection
Call newsCol.AddDocument(doc)
If Not (newsCol.Count = 1) Then
' error, collection should now contain the current doc
Print "Cancelled: Current document could not be added to forward (newsletter)."
Exit Sub
End If
' forward current doc
Call ForwardDocAsNews(db, newsCol, msubject, mreplyto, sendtoLst)
Exit Sub
End If
SErrorHandler:
Print "Error: " & Cstr(Err) & ", " & Error$ & ", one line: " & Cstr(Erl) & "."
Exit Sub
End Sub
Function ForwardDocAsNews(db As NotesDatabase, newsCol As NotesDocumentCollection, msubject As String, mreplyto As String, msendtoLst As Variant) As Integer
' function sends one document in a collection as a "newsletter" (similar to @Forward vs table if multiple docs in collection)
' returns 1 = success sent, 0 = failure sending, also prints error message if one occurs
' db - current app
' newsCol - collection containing one doc to forward
' msubject - subject of memo being sent
' mreplyto - override reply to address (optional)
' msendtoLst - can be string or string list (typically a list)
Dim nNews As NotesNewsletter ' the doc to forward in newsCol
Dim mDoc As NotesDocument ' memo document
On Error Goto FErrorHandler
' start function with status = 0
ForwardDocAsNews = 0
' create newsletter/forward from 1 collection doc
Set nNews = New NotesNewsletter( newsCol )
Set mDoc = nNews.FormatDocument( db, 1 )
mDoc.SaveMessageOnSend = False
Call mDoc.ReplaceItemValue("Form", "Memo")
Call mDoc.ReplaceItemValue("Subject", msubject)
Call mDoc.ReplaceItemValue("ReplyTo", mreplyto)
Call mDoc.ReplaceItemValue("SendTo", msendtoLst)
' send completed newsletter
Call mDoc.Send( False, msendtoLst )
Print "Message Sent."
ForwardDocAsNews = 1
FExit:
Set mDoc = Nothing
Exit Function
FErrorHandler:
Print "Error forwarding document: " & Cstr(Err) & " " & Error$ & ", line: " & Cstr(Erl) & "."
Resume FExit
End Function
Solution 2:
This version of a forward function, assumes you are passing in two documents, one contains the SendTo field, and one contains the document to snapshot and forward.
(agent is called as wqs agent from pop-up form)
Options
Option Public
Option Declare
Sub Initialize
Dim s As New NotesSession
Dim db As NotesDatabase ' current db
Dim popDoc As NotesDocument ' current popup doc
Dim edocunid As String ' current doc unid from popDoc's DocUNID field
Dim eDoc As NotesDocument ' current doc to forward, obtained using edocunid
On Error Goto SErrorHandler
' setup
Set popDoc = s.DocumentContext
Set db = s.CurrentDatabase
edocunid = popDoc.DocUNID(0)
If (edocunid="") Then
Print "Error: Missing document to forward. Cannot continue. (No DocUNID)."
Exit Sub
End If
Set eDoc = db.GetDocumentByUNID(edocunid)
If (eDoc Is Nothing) Then
Print "Error: Cannot locate document to forward. Cannot continue. (Doc UNID: " & edocunid & ")."
Exit Sub
End If
' have doc, start printout and forward (DoForward will print whether or not there is an error.)
Print "<strong>Sending Document . . . </strong><br/><br/>"
Call DoForward(db, popDoc, eDoc, "tmpSendto", s.EffectiveUserName)
Print "<br/><br/>"
Print |<a href="javascript: window.close();" onClick="window.close();"> Close Window </a>|
SExit:
Exit Sub
SErrorHandler:
Print "Unexpected Error: " & Cstr(Err) & " " & Error$ & ", line: " Cstr(Erl) & "."
Resume SExit
End Sub
Function DoForward(db As NotesDatabase, popDoc As NotesDocument, eDoc As NotesDocument, sendtofldnm As String, fromnm As String) As Integer
' db - current db
' popDoc - pop up name selection forwarding dialog (contains sendto field)
' eDoc - document being forwarded
' sendtofldnm - sendto field name
' fromnm - from NotesName or e-mail address
Dim sendToItem As NotesItem ' sento field in popDoc
Dim tmpCol As NotesDocumentCollection ' temp collection to hold eDoc from which to create newsletter
Dim tmpNDT As NotesDateTime ' temp date/time for the bogus search
Dim enewsletter As NotesNewsletter ' the snapshot document to forward
Dim mDoc As NotesDocument ' memo doc that contains the newsletter doc
On Error Goto FErrorHandler
' start failure
DoForward = 0
' get send to
Set sendToItem = popDoc.GetFirstItem(sendtofldnm)
If (sendToItem Is Nothing) Then
'give up
Exit Function
End If
If (sendToItem.Text = "") Then
'give up
Exit Function
End If
' have at least one person to send to, continue . . .
' . . . create temp collection
Set tmpNDT = New NotesDateTime("01/01/1991")
Set tmpCol = db.Search( "@Contains( Subject; ""asdf1235asdfa31251235asdf1235"" )", tmpNDT, 1 ) ' we don't want success
Call tmpCol.AddDocument(eDoc)
' create newsletter from eDoc
Set enewsletter = New NotesNewsletter( tmpCol)
Set mDoc = enewsletter.FormatDocument( db, 1)
Call mDoc.ReplaceItemValue("Form", "Memo")
Call mDoc.CopyItem(sendToItem, "SendTo")
mDoc.SaveMessageOnSend = False
Call mDoc.Send(False)
Print "Message Forwarded"
DoForward = 1
FExit:
Exit Function
FErrorHandler:
Print "Error Forwarding Mail: " & Cstr(Err) & " " & Error$ & ", line: " Cstr(Erl) & "."
DoForward = 0
Resume FExit
End Function
______________________________________________
Solution 2:
This version of a forward function, forwards one or more selected documents in a Notes client view by clicking a Forward or Send button on the current document when in read mode.
Function ForwardDocsSelected(db As NotesDatabase, dc As NotesDocumentCollection, msubject As String, mreplyto As String, msendtoLst As Variant) As Integer
' function sends one or more documents in a collection as a "picture" (similar to @Forward vs table if multiple docs in collection)
' returns 1 = success sent, 0 = failure sending, also prints error message if one occurs
' db - current app
' dc - collection containing one or more docs to forward
' msubject - subject of memo being sent
' mreplyto - override reply to address (optional)
' msendtoLst - can be string or string list (typically a list)
Dim tmpDoc As NotesDocument ' current doc in dc being snapshot
Dim tmpItem As NotesRichTextItem ' temp item for taking snapshot picture of current document
Dim tmpsuccess As Variant ' flag whether rendering to RTF tmpItem works each time
Dim mDoc As NotesDocument ' memo being sent
Dim mBody As NotesRichTextItem ' body field of new memo, mDoc
On Error Goto FErrorHandler
' start function with status = 0
ForwardDocsSelected = 0
' create new memo
Set mDoc = db.CreateDocument()
Call mDoc.ReplaceItemValue("Form", "Memo")
mDoc.SaveMessageOnSend = False
Call mDoc.ReplaceItemValue("Subject", msubject)
If Not (mreplyto = "") Then
Call mDoc.ReplaceItemValue("ReplyTo", mreplyto)
End If
Call mDoc.ReplaceItemValue("SendTo", msendtoLst)
Set mBody = New NotesRichTextItem(mDoc, "Body")
' loop and add docs to body of e-mail
Set tmpDoc = dc.GetFirstDocument()
While Not (tmpDoc Is Nothing)
' copy current doc to temp item in new doc
Set tmpItem = New NotesRichTextItem(mDoc, "TmpRTF")
success = tmpDoc.RenderToRTItem( tmpItem )
If (success) Then
' add contents
Call mBody.AppendRTItem( tmpItem )
' add delineator
Call mBody.AppendText("_____________________________________________")
Call mBody.AddNewLine(1)
Set tmpItem = Nothing
Else
Print "Error adding document, " & tmpDoc.UniversalID & ", to new e-mail. Skipped."
End If
' loop
Set tmpDoc = dc.GetNextDocument(tmpDoc)
Wend
' clear tmpitem so not in new memo
Set tmpItem = Nothing
' send completed e-mail/forward collection
Call mDoc.Send( False, msendtoLst )
Print "Message Sent."
ForwardDocsSelected = 1
FExit:
Set mDoc = Nothing
Exit Function
FErrorHandler:
Print "(ForwardDocsSelected) Error forwarding document(s): " & Cstr(Err) & " " & Error$ & ", line: " & Cstr(Erl) & "."
Resume FExit
End Function
previous page
|