Hi.Can anyone assist me as to how I can get an action hotspot via DXL?
I have a form that contains a rich text field named BodyAttachFilesRT.
I have a button that triggers the agent agtAttachFileInDoc (shown below).
What this agent does is grab a file and attach it into a doc created and saved in a db which we shall call AttachDb.nsf.
That part works fine.
What I want eventually is to put the doclink into this doc’s BodyAttachFilesRT field.
Since I did not like the look of a doclink, I wanted an action hotspot without the green border, which contains LS to call the attachdoc.
Everytime it reaches the import.Process, my client crashes.
I have tested it by exporting it via DXLExporter to check the XML/DXL structure, which looked ok.
I am at a loss at this point and in need of some help!
Below is my agent code:
%REM
Agent agtAttachFileInDoc
%END REM
Option Public
Option Declare
Sub Initialize()
Dim uiws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim sess As New NotesSession
Dim db As NotesDatabase, dbAttch As NotesDatabase
Dim vw As NotesView
Dim doc As NotesDocument, docLU As NotesDocument, _
docAttch As NotesDocument, docTmp As NotesDocument
Dim strAttchFrmNam As String, strBodyFldNam As String, _
strAttchFilPath As String, strAttchFilNam As String, _
strAttchDocID As String, strAttchLUVwNam As String, _
strDefBodyFldNam As String, strAbstrct As String, _
strLUvwAdmNam As String, strLUDocKey As String, _
strAttchSvr As String, strAttchDb As String, _
strAttchVw As String, strDlm As String, strDocLUVal As String
Dim itm As NotesItem, itmTmp As NotesItem
Dim rtitm As NotesRichTextItem, rtitmAttch As NotesRichTextItem, _
rtitmTmp As NotesRichTextItem
Dim intFilNum As Integer
Dim varPrmpt As Variant, varOKdocAttch As Variant, _
varSysFileLastMod As Variant, varSysFileLen As Variant, _
varSysFileLOF As Variant
Dim itmBdy As NotesItem
Dim rttrnge As NotesRichTextRange
Dim rtnav As NotesRichTextNavigator
Dim rtEmbedObj As NotesEmbeddedObject
Dim rtDocLnkDef As NotesRichTextDocLink
strDlm = |~|
strLUvwAdmNam = |vwAdminDbProfileKeywords|
strLUDocKey = |AttachFileSvrDbViewFormNotes|
strDefBodyFldNam = |Body| 'used when no specific RTF name is found.
Set uidoc = uiws.Currentdocument
Set doc = uidoc.Document
varPrmpt = uiws.Prompt (12, |Select a file to attach...|, _
|Choose a file to attach: |)
If Trim (CStr (varPrmpt)) = "" Then
MsgBox |No file was selected. Agent aborting now.|,,_
|Error! No file found!|
Exit Sub
End If
strAttchFilPath = CStr (varPrmpt) ' full path incl file name
strAttchFilNam = StrRightBack (strAttchFilPath, "\")
Set db = sess.Currentdatabase
Set vw = db.Getview (strLUvwAdmNam) 'get Admin Keyword view
Set docLU = vw.Getdocumentbykey (strLUDocKey, True)
If docLU Is Nothing Then
MsgBox |The Admin Keyword doc "| & strLUDocKey & |" is not found.|_
,,|Error! Missing Keyword doc!|
Exit Sub
End If
strDocLUVal = docLU.KeywordValue01TX (0)
strAttchSvr = StrToken (strDocLUVal, strDlm, 1)
strAttchDb = StrToken (strDocLUVal, strDlm, 2)
strAttchVw = StrToken (strDocLUVal, strDlm, 3) ' |vwLUAllAttachments|
strAttchFrmNam = StrToken (strDocLUVal, strDlm, 4) ' |frmAttachFile|
'get Attachment Db
If strAttchSvr = "" Or strAttchSvr = |Server| Then
strAttchSvr = db.Server
End If
Set dbAttch = sess.Getdatabase (strAttchSvr, strAttchDb)
If dbAttch.Isopen = False Then
Call dbAttch.Open ("", "")
End If
'if still unable to open, quit function and sub later
If dbAttch.Isopen = False Then
MsgBox |Attachment db in | & strAttchSvr & | : | & strAttchDb & _
| cannot be accessed.|,,|Error! Attachment Db cannot be opened!|
Exit Sub
End If
Set docAttch = dbAttch.Createdocument()
docAttch.Form = strAttchFrmNam
varOKdocAttch = docAttch.Computewithform (True, False)
If varOKdocAttch = False Then
Print |Could not validate the | & strAttchFrmNam & | form.|
End If
'get sys file modified datetime 1st before attaching
intFilNum = FreeFile ()
Open strAttchFilPath For Input As intFilNum
varSysFileLastMod = FileDateTime (strAttchFilPath)
varSysFileLen = FileLen (strAttchFilPath) 'file length when closed
varSysFileLOF = LOF (intFilNum) 'file length when opened
Close intFilNum
Set rtitmAttch = docAttch.Createrichtextitem (strDefBodyFldNam)
’ If rtitm.Type = RICHTEXT Then
Call rtitmAttch.Embedobject (1454, "", strAttchFilPath)
’ End If
docAttch.OrigSysFilePathTX = strAttchFilPath 'attachment path origin
docAttch.OrigSysFileSizeNO = clng (varSysFileLen) 'attachment size origin
docAttch.OrigSysFileLOFNO = CLng (varSysFileLOF) 'opened attachment size origin
docAttch.OrigSysFileModDateTimeDT = CDat (varSysFileLastMod) 'attachment modified date origin
Call docAttch.Save (True, False)
strAttchDocID = docAttch.DocIDTX (0) 'get th Attach Doc ID for URL
'create a new temp doc to generate the action hotspot
Set docTmp = CreateNewActionHotSpot (strAttchSvr, strAttchDb, strAttchVw, _
strAttchFilNam, strAttchDocID, strLUvwAdmNam, strLUDocKey, strDlm)
'get temp doc Body item
Set itmTmp = docTmp.Getfirstitem (strDefBodyFldNam)
'get current doc body field
strBodyFldNam = "BodyAttachFilesRT"
Set itm = doc.Getfirstitem (strBodyFldNam)
Set rtitm = itm
If itmTmp.Type = RICHTEXT Then
Set rtitmTmp = itmTmp
Call rtitm.AppendRTItem (rtitmTmp)
Else
Call rtitm.Appendtext (|DocID: | & strAttchDocID & | cannot be linked!|)
End If
Call docTmp.Remove(True)
strAbstrct = Trim (rtitm.Abstract (1, True, False))
If strAbstrct >< "" Then
else
Call rtitm.Addnewline (2, True)
End If
Call doc.Save (True, False)
Call rtitm.Update()
Set uidoc = uiws.Editdocument (True, doc)
Call uidoc.Gotofield (strBodyFldNam)
End Sub
'=======================
Function CreateNewActionHotSpot (strSvr As String, strDb As String, _
strVw As String, strAttchFilNam As String, strDocID As String, _
strLUVwNam As String, strLUKey As String, strDlm As String) As NotesDocument
' Purpose: Build a doc using DXL & import into current db & return a New doc
Dim sess As New NotesSession
Dim db As NotesDatabase, dbAttch As NotesDatabase
Dim vwAttch As NotesView
Dim docAttch As NotesDocument
Dim strDXLHdr As String, strDXLDbInfo As String, _
strDXLDocIn As String, strDXLItmIn As String, _
strDXLRTFIn As String, strDXLParDef As String, _
strDXLParIn As String, strDXLAtnHtSptIn As String, _
strDXLLSCodeOptIn As String, strDXLLSCodeOptOut As String, _
strDXLCodeIn As String, strDXLLSCodeIn As String, _
strDXLLSCodeLines As String, strDXLCodeOut As String, _
strDXLLSCodeOut As String, strDXLAtnHtSptTxt As String, _
strDXLAtnHtSptOut As String, strDXLParOut As String, _
strDXLRTFOut As String, strDXLItmOut As String, _
strDXLDocOut As String, strDXLDbOut As String, strDXLBR As String, _
filnam As String
Set db = sess.Currentdatabase
If strSvr = "" Or strSvr = |Server| Then
strSvr = db.Server
End If
On Error GoTo ErrorHandler
Dim newdoc As NotesDocument
Dim stream As NotesStream
Dim imprtr As NotesDXLImporter
Set stream = sess.CreateStream
' Build the DXL doc incl the URL Link in Rich Text field
strDXLBR = |<break>|
strDXLHdr = |<&xml version='1.0' encoding='utf-8' ?>| & _
|<database xmlns="http://www.lotus.com/dxl" version="1.01">|
strDXLDbInfo = |<databaseinfo replicaid="| & db.ReplicaID & |"/>|
strDXLDocIn = |<document form="frmTMPActionHotSpot">|
strDXLItmIn = |<item name='Body'>|
strDXLRTFIn = |<richtext>|
strDXLParDef = |<pardef id="parStyle01" leftmargin="0in" spaceafter="1.5" />|
strDXLParIn = |<par def="parStyle01">|
strDXLAtnHtSptIn = |<actionhotspot hotspotstyle="none">|
'strDXLAtnHtSptIn = |<actionhotspot showborder="false">|
strDXLLSCodeOptIn = |<code event="Options">| & _
|<lotusscript><![CDATA[Option Public
Option Declare]]>|
strDXLLSCodeOptOut = |</lotusscript></code>|
strDXLLSCodeIn = |<code event="Click"><lotusscript>|
strDXLLSCodeLines = |<![CDATA[Sub Click (Source As Button)
'Action Hotspot to open the attachment doc
REM – line separator –
Dim uiws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim sess As New NotesSession
Dim db As NotesDatabase, dbAttch as NotesDatabase
Dim vw As NotesView, vwAttch as NotesView
Dim doc As NotesDocument, docLUKey as NotesDocument, _
docAttch As NotesDocument
Dim strSvr As String, strDbAttchNam As String, _
strVwAttchNam As String, strLUVwNam As String, _
strLUDocKey As String, strDocID As String, strDlm As String
Set db = sess.CurrentDatabase
Set uidoc = uiws.CurrentDocument
Set doc = uidoc.Document
strDlm = “| & strDlm & |”
strLUVwNam = “| & strLUVwNam & |”
strLUDocKey = “| & strLUKey & |”
Set vw = db.GetView (strLUVwNam)
Set docLUKey = vw.GetDocumentByKey (strLUDocKey)
strSvr = StrToken (docLUKey.KeywordValue01TX (0), strDlm, 1)
strDbAttchNam = StrToken (docLUKey.KeywordValue01TX (0), strDlm, 2)
strVwAttchNam = StrToken (docLUKey.KeywordValue01TX (0), strDlm, 3)
If strSvr = “” Or strSvr = “Server” Then
strSvr = sess.Currentdatabase.Server
End If
Set dbAttch = sess.Getdatabase (strSvr, strDbAttchNam)
If dbAttch.Isopen = False Then
Call dbAttch.Open (“”, “”)
End If
'if still unable to open, quit sub now.
If dbAttch.Isopen = False Then
MsgBox "Attachment db in " & strSvr & " : " & strDbAttchNam & _
" cannot be accessed.",“Error! Attachment Db cannot be opened!”
Exit Sub
End If
strDocID = “| & strDocID & |”
Set vwAttch = dbAttch.GetView (strVwAttchNam)
Set docAttch = vw.GetDocumentByKey (strDocID)
If docAttch Is Nothing Then
MsgBox “Attachment doc " & strDocID & " cannot be accessed for some reason.” & _
“Please check with the Development Team about this.”,“No Attachment Doc found!”
Exit Sub
End If
Call uiws.EditDocument (False, docAttch, False,True, True)
End Sub]]>|
strDXLLSCodeOut = |</lotusscript></code>|
strDXLAtnHtSptTxt = strAttchFilNam & | (DocID: | & strDocID & |)|
strDXLAtnHtSptOut = |</actionhotspot>|
strDXLParOut = |</par>|
strDXLRTFOut = |</richtext>|
strDXLItmOut = |</item>|
strDXLDocOut = |</document>|
strDXLDbOut = |</database>|
Call stream.WriteText (strDXLHdr & strDXLDbInfo & strDXLDocIn & _
strDXLItmIn & strDXLRTFIn & strDXLParDef & strDXLParIn & _
strDXLAtnHtSptIn & strDXLLSCodeOptIn & strDXLLSCodeOptOut & _
strDXLLSCodeIn & strDXLLSCodeLines & _
strDXLLSCodeOut & strDXLAtnHtSptTxt & strDXLAtnHtSptOut & _
strDXLParOut & strDXLRTFOut & strDXLItmOut & strDXLDocOut & _
strDXLDbOut, EOL_CR)
' Import new doc with action hotspot into current db
Set imprtr = sess.CreateDXLImporter (stream, db)
'imprtr.DocumentImportOption = DXLIMPORTOPTION_CREATE
imprtr.Inputvalidationoption = 0
imprtr.Process
ErrorHandler:
if not imprtr is nothing then
MsgBox imprtr.Log
end if
Exit Function
End Function