rikkeith
asked on
Create a Visio Diagram based PDF from Lotuscript in R6.5.1? Without using OLE.
Hi there,
Does anyone wish to know how to generate/populate a Visio Diagram based PDF file on the fly? This is my first time in here posting info and I wanted to post a solution I've developed.
Does anyone wish to know how to generate/populate a Visio Diagram based PDF file on the fly? This is my first time in here posting info and I wanted to post a solution I've developed.
Can you show me the solution: http:Q_20963198.html
We are all stilll waiting with baited breath!
Forget it rikkeith.
ASKER
OK,
Firstly sorry for the delay in getting this to you.
My solution requires a wee bit of OLE to be honest for the .VDX(Visio XML document)->.VSD file conversion and the final conversion to PDF format. However the latter OLE option is avoidable with the use of the DocConverter Product that I have adopted to use here. Ref. http://www.neevia.com/prodDC.htm
The conversion to VSD is only required since a lot of third party conversion
There are a few prerequisits to implementing this solution.
These are as follows.
1. The client browser viewing the resultant output has a Visio viewer active X component and Adobe Acrobat 5 incstalled at least.
2. The Domino server should be R6.x at least as the code required to parse XML via lotuscript is only available in R6.
3. The Domino Server should have the MS Visio 2003 installed for the VDX to VSD conversion.
4. The Domino Server should have the DocConverter Product installed for the VSD to PDF conversion.
Scenario:
We have a web form to capture our user's data that we wish to transpose onto our Visio/pdf output diagram.
Requirements:
Create the Visio diagram that you wish to use as the template for the output visio diagram. Once you have pupolated all the shapes with their titles and defined the text areas that will be updated, save the file in VSD format and also in VDX format.
Now open up the VDX file in IE5 and you will see the XML document produced. This is what you will be working with when you parse the XML within the document.
The key Node Elements that you will be dealing with are as follows:
VisioDocument
Pages
Page
Shapes
Shape
The web form's fields text data will be used to populate specific shapes and the text therein.
Each field in the web form requires to be mapped to a specific shape on the diagram.
Get shape ID's:
By openning and selecting each shape in your visio diagram, you will be able to get each shapes ID number.
You should then create a keyword lookup form and views for this purpose.
the data I Used is as follows:
Web Form Field Name:
VDX File Elements:-
Element Name:
Element ID Attribute:
Element NameU Attribute: .
(for check box only : Checkbox ID Attribute:)
For Divided Process shape only : Divided Process Element ID: of the shape in the Divided process that holds that text you wish to change.)
Once you have completed creating your mapping documents with a corresponding lookup views(which I'll leave upto your discretion),
then create a VDX template form to hold your VDX template which will be used to create your populated VDX diagram, and resultant PDF file.
The agent code that I used for generating VISIO based PDFs is as follows:
(Options)
Option Public
Option Declare
(Declarations)
REM Constants found in a Notes names.nsf DXL file
REM Node names
Const DOCUMENT_NODE_NAME = "VisioDocument"
Const PAGES_NODE_NAME = "Pages"
Const PAGE_NODE_NAME = "Page"
Const SHAPES_NODE_NAME = "Shapes"
Const SHAPE_NODE_NAME = "Shape"
REM Attribute names
Const ID_ATTR_NAME = "ID"
Const NAMEU_ATTR_NAME = "NameU"
REM Attribute values
Const ID = "ID"
Const NAMEU = "NameU"
' Arrays for Fieldto VDX Element mapping
Dim FieldArray() As String
Dim VDXElementArray() As String
Dim docList As NotesDOMNodeList 'list of <VisioDocument> nodes
Dim pagesList As NotesDOMNodeList 'list of <Pages> nodes
Dim pageList As NotesDOMNodeList 'list of <Page> nodes
Dim shapesList As NotesDOMNodeList 'list of <Shapes> nodes
Dim shapeList As NotesDOMNodeList 'list of <Shape> nodes
Dim subshapeList As NotesDOMNodeList 'list of <Shapes/shape> nodes
Dim actList As NotesDOMNodeList 'list of <Act> nodes
Dim itemList As NotesDOMNodeList 'list of <item> nodes
Dim userList As NotesDOMNodeList 'list of <user> nodes
Dim eNode As NotesDOMElementNode 'a <document form= > node
Dim iNode As NotesDOMNode 'an <item> node
Dim txtNode As NotesDOMNode ' an <text> node
Dim textChild As NotesDOMNode 'the actual data value
Dim tNode As NotesDOMElementNode 'a <text> node; where we append new text data
Dim attrNode As NotesDOMAttributeNode 'attributes of <item> node
Dim attrs As NotesDOMNamedNodeMap
Dim numChildren As Integer
Dim iAttr As Integer 'attribute counter
Dim AttrVal As Variant
Dim iDoc As Integer 'counter for docList
Dim wDoc As Integer 'counter for docList
Dim yDoc As Integer 'counter for docList
Dim zDoc As Integer 'counter for docList
Dim tDoc As Integer 'counter for docList
Dim subDoc As Integer ' counter for subshapelist
Dim actDoc As Integer ' counter for actList
Dim userDoc As Integer ' Counter for userlist
Dim iItem As Integer 'counter for itemList
Dim newData As String 'user input
Dim newChild As NotesDOMNode 'node used for the append operation
Dim m As Integer 'match list counter
Dim v As Integer ' vdxarray counter
Dim i As Integer ' pointer to first | in VDX Array entry.
Dim n As Long
Dim domParser As NotesDOMParser
Dim docNode As NotesDOMDocumentNode
Dim rootElement As NotesDOMElementNode
Dim session As NotesSession
Dim inputStream As NotesStream
Dim outputStream As NotesStream, outputLog As NotesStream
Dim origXML As String, reportFile As String, logFile As String, outputXML As String
Dim outputVSD As String, outputPDF As String
Dim pdfURL As String
Dim NL As String 'carriage return + line feed
Dim LF As String '
Dim view As NotesView
Dim object As NotesEmbeddedObject
Dim db As NotesDatabase
Dim pdfhtml As String
(Initialise)
Sub Initialize
Dim xdoc As NotesDocument
Dim vwPEP As NotesView
Dim docPEP As NotesDocument
Dim queryString As String
Dim unid As String
Dim userName As String
Dim action As String
Dim startUNID As Integer
Dim startName As Integer
Dim rest As String
Dim tmp As String
Dim map As String
'Delcare error handling for entire script
On Error Goto Errorhandler
Set session = New NotesSession
Set db = session.currentdatabase
Set vwPEP = db.GetView("PEPbyUniqueId"
Set xdoc = session.DocumentContext
' Call xdoc.Save(True, False)
queryString$ = xdoc.Query_String(0)
unid$ = getParm(queryString$, "UNID") ' The unique ID for the DocumentContext.
map$ = getParm(queryString$, "map") 'The diagram type flag.
Set docPEP = vwPEP.GetDocumentByKey( unid$ )
If docPEP Is Nothing Then
Print "Unable to find document " + unid$
Exit Sub
End If
Call getVDXTemplate(map$)
Call CollectPEPData(docPEP, map$)
Call UpdateVDX
Call ExportVDXtoPDF(docPEP)
Call KillTempFiles
Call PublishPDFtoWeb(docPEP)
Print pdfhtml
Exit Sub
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("Initialize - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Sub
Sub GetVDXTemplate(mapType As String)
'Delcare error handling for entire script
On Error Goto Errorhandler
Dim rtitem As Variant
Dim inputFullpath As String
Dim outputFullpath As String
Dim filepath As Variant
Dim PDFOutput As Variant, tmp As Variant
Dim datestr As Variant
Dim item As NotesItem
Dim tView As NotesView
Dim tmpltDoc As NotesDocument
Dim timestamp As New NotesDateTime(Now)
'#########################
' This sub is used to get the correct VDX template for the MAP option specified and extract this file to the
' \\server.domain.local\E$\L
'under a timestamped renamed version of the file.
'This file path is then used by OrigXML and the InputStream in the UpdateVDX sub to facilitate parsing of the unique VDX file
'prior to conversion to PDF
'#########################
'Get the timestamp for this instant
datestr = Cstr(Format(timestamp.lsLo
'Get the correct VDX file template
Set tView = db.getView("vdxtemplate")
If Not (tView Is Nothing) Then
Select Case(mapType)
Case "RoadMap" :
tmp = "VDXRoadMapTemplate"
Case "Concept" :
tmp = "Phase1Template"
Case "Feasibility" :
tmp = "Phase2Template"
Case "Development" :
tmp = "Phase3Template"
Case "Implementation" :
tmp = "Phase4Template"
Case "Termination" :
tmp = "Phase5Template"
End Select
Set tmpltDoc = tView.GetDocumentByKey(tmp
If Not (tmpltDoc Is Nothing) Then
Set object = tmpltDoc.GetAttachment( tmpltDoc.Att_name(0) )
If Not (object Is Nothing) Then
'Get unc filepath for vdxcache directory on Server to hold the VDX file
If ( object.Type = EMBED_ATTACHMENT ) Then
'Specify the full path of the xml file that will be updated with PEP information
filepath = getParameter("vdxcache")
PDFOutput = getParameter("PDFDirectory
OrigXML = Cstr(filepath(0))+datestr+
outputXML = Cstr(filepath(0))+datestr+
outputVSD = Replace(outputXML,".vdx","
outputPDF = Replace(Cstr(PDFOutput(0))
'Update OrigXML for Inputstream process in UpdateVDX sub
' Extract the file to the SSYDAPP01
' (Domino Server running as account with read/write access to the file system)
Call object.ExtractFile(OrigXML
Call object.ExtractFile(outputX
End If
End If
End If
End If
Exit Sub
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("GetVDXTemplate - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Sub
Sub CollectWebformData (Webdoc As NotesDocument, map As String)
Dim webfield As Variant
Dim webvalue As Variant
Dim ElementName As Variant
Dim ID As Variant
Dim NameU As String
Dim DPShapeID As Variant
Dim NameU_All As Variant
'Collect all vdx mapping documents as redim each array with the collection.count
'parse through the web document and assign each updated field to the correct VDX mapping value
'Open web field to VDX element mapping view
Dim VDXmapping As NotesView
Dim vdxmapdoc As NotesDocument
Dim i As Integer ' - counter for vdxmapdoc
Dim x As Integer
'Delcare error handling for entire script
On Error Goto Errorhandler
'Update the above arrays with data from web prior to passing stored values to the corresponding VDX element
' initialise counter
i=0
'Parse though mapping and update the arrays with data that is held in the respective fields
Set VDXmapping=db.GetView("vdx
Set vdxmapdoc = VDXmapping.GetFirstDocumen
While Not vdxmapdoc Is Nothing
webfield = vdxmapdoc.GetItemValue("we
webvalue = PEPdoc.GetItemValue(webfie
'if Other specified for Tasks, pick the other data entered
If webvalue(0)="Other" Then
pepvalue = PEPdoc.GetItemValue(webfie
End If
If Ubound(webvalue) > 0 Then
For x=1 To Ubound(webvalue)
webvalue(0) = webvalue(0) + "|" + webvalue(x)
Next
Redim Preserve webvalue(0)
End If
'web value to populate in FieldArray
If Not (webvalue(0)="") Then
Redim Preserve FieldArray(i)
FieldArray(i) = webvalue(0)
ElementName = vdxmapdoc.GetItemValue("El
ID = vdxmapdoc.GetItemValue("ID
NameU_All = vdxmapdoc.GetItemValue("Na
DPShapeID = vdxmapdoc.GetItemValue("DP
Redim Preserve VDXElementArray(i)
If Not DPShapeID(0) = "" Then
VDXElementArray(i) = ElementName(0)+"|"+ID(0)+"
i=i+1
Else
VDXElementArray(i) = ElementName(0)+"|"+ID(0)+"
i=i+1
End If
End If
Set vdxmapdoc = VDXmapping.GetNextDocument
Wend
Exit Sub
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("CollectPEPData - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Sub
Sub UpdateVDX
'#########################
' This sub is used to parse the VDX inputStream file XML object and update the outputStream file
'The principle fucntionality is held in processShapes
'#########################
Dim id As String
Dim nameu As String
'Delcare error handling for entire script
On Error Goto Errorhandler
If Not createFiles( "Update Contacts List") Then Exit Sub
'The following creates input and output streams
'Set notesDOMParser = notesSession.CreateDOMPars
Set domParser=session.CreateDO
domParser.Process
'Now the the XML is in Dom Parser, truncate the input file so that we can repopulate it with the updated xml
'inputStream.Truncate
Set docNode = domParser.Document
Set rootElement = domParser.Document.Documen
Set pagesList = rootElement.GetElementsByT
If pagesList.NumberOfEntries = 0 Then Exit Sub
For iDoc = 1 To pagesList.NumberOfEntries 'search <Pages...> nodes
Set eNode = pagesList.GetItem(iDoc)
If eNode.NumberOfChildNodes > 0 Then
REM Element name ='Pages'>
Set pageList = eNode.GetElementsByTagName
If pageList.NumberOfEntries = 0 Then Exit Sub
For wDoc = 1 To pageList.NumberOfEntries 'search <Page...> nodes
Set eNode = pageList.GetItem(wDoc)
If eNode.NumberOfChildNodes > 0 Then
REM Element name ='Pages'>
Set shapeList = eNode.GetElementsByTagName
If shapeList.NumberOfEntries = 0 Then Exit Sub
Call processshapes
End If ' if pagelist.NumberOfEntries >0
Next ' - Get all in pageList
End If ' - pagesList.NumberOfEntries > 0
Next ' - Get all in pagesList
'Walks the DOM document tree and streams the resulting XML to the DOM parser's output object, provided one was specified.
Call domParser.Serialize()
Call inputStream.Close
Call outputStream.Close
Exit Sub
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("UpdateVDX - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Sub
Function createFiles(title As String)
'#########################
' This function creates the NotesStream to the VDX files on
' \\server.domain.local\E$\L
' for input and output and outputlog( as applicable)
'#########################
'Delcare error handling for entire script
On Error Goto Errorhandler
createFiles = True
'create the output file
Set outputStream = session.CreateStream
outputStream.Open (outputXML)
outputStream.Truncate
'open the input XML file
Set inputStream = session.CreateStream
inputStream.Open (origXML)
If inputStream.Bytes = 0 Then createFiles = False
Exit Function
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print(" createFiles - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Function
Function processShapes
Dim id As String
Dim nameu As String
Dim dpshapeid As String
Dim tVal As String
Dim rkVal As String
Dim rVal As String
Dim offset As Long
'Delcare error handling for entire script
On Error Goto Errorhandler
NL = Chr(13) + Chr(10)
'Now we parse through the VDXElementArray to get the ID and NameU attributes
For v=0 To Ubound(VDXElementArray)
i = Instr(VDXElementArray(v),"
n = Instr(i+1,VDXElementArray(
m = Instr(n+1,VDXElementArray(
id = Mid(VDXElementArray(v),i+1
If m<=0 Then
nameu = Mid(VDXElementArray(v),n+1
Elseif m>0 Then
nameu = Mid(VDXElementArray(v),n+1
'Get the Divided Process Shape ID with text to update
dpshapeid = Mid(VDXElementArray(v),m+1
'******************replace
id = dpshapeid
'*************************
End If
For zDoc = 1 To shapeList.NumberOfEntries 'search <Shape...> nodes
Set eNode = shapeList.GetItem(zDoc)
If eNode.NumberOfChildNodes > 0 Then
If eNode.GetAttribute(ID_ATTR
If Instr(nameu,"Check box") >0 Then
Set actList = eNode.GetElementsByTagName
Set subshapeList = eNode.GetElementsByTagName
Set userList = eNode.GetElementsByTagName
If actList.NumberOfEntries = 0 Then Exit Function
If subshapeList.NumberOfEntri
If userList.NumberOfEntries = 0 Then Exit Function
For actDoc= 1 To actList.NumberOfEntries 'search <Act...> nodes
Set eNode = actList.GetItem(actDoc)
Select Case eNode.GetAttribute("IX")
Case 0 : ' Set Shading Case 1 :
'_Unchecked action - This is the Text Child Node for _unchecked node
Set textChild = eNode.Firstchild.NextSibli
rkVal = textChild.NodeValue
textchild.NodeValue = "0"
Case 2 :
' Checked action - This is the Text Child Node for checked node
Set textChild = eNode.Firstchild.NextSibli
rkVal = textChild.NodeValue
textchild.NodeValue = "1"
Case 3 : 'Cross Mark
End Select
Next
For userDoc= 1 To userList.NumberOfEntries 'search <User...> nodes
Set eNode = userList.GetItem(userDoc)
Set textChild = eNode.Firstchild.NextSibli
rkVal = textChild.NodeValue
textchild.NodeValue = "1"
Next
For subDoc= 1 To subshapeList.NumberOfEntri
Set eNode = subshapeList.GetItem(subDo
Select Case eNode.GetAttribute("Master
Case 11 :
'NoShow Node - This is the Text Child Node for checked node
Set textChild = eNode.LastChild.PreviousSi
textchild.NodeValue = "0"
End Select
Next
Goto getnext
Else
tVal = FieldArray(v)
Set textchild = eNode.lastchild ' Must now get Previous sibling as this is the text node
Set txtNode = textchild.PreviousSibling ' this is the text node
Set textChild = txtNode.Firstchild ' This is the Text Child Node hold
If textChild.NodeName = "pp" Or textChild.NodeName = "cp" Then '
Set textChild = textchild.NextSibling ' this is the text node
End If
rkVal = textChild.NodeValue
If Instr(rkVal,"Goal:")>0Then
textchild.NodeValue = "Goal: "+FieldArray(v)
Elseif Instr(tVal," - Select -")>0 Then
textchild.NodeValue = ""
Elseif Instr(rkVal,"ROAD PLAN")>0 Then
textchild.NodeValue = "ROADMAP "+FieldArray(v) + " - Published "+ Format(Now,"dd/mm/yyyy")
Elseif Instr(rkVal,"Executive Names")>0 And Instr(tVal,"|")>0 Then
rVal = Replace(FieldArray(v),"|",
textchild.NodeValue = rVal
Elseif Instr(rkVal,"Project Team Names")>0 And Instr(tVal,"|")>0 Then
rVal = Replace(FieldArray(v),"|",
textchild.NodeValue = rVal
Elseif Instr(rkVal,"No Data")>0 And Instr(tVal,"|")>0 Then
rVal = Replace(FieldArray(v),"|",
textchild.NodeValue = rVal
Else
textchild.NodeValue = FieldArray(v)
End If
rkVal = textChild.NodeValue
Goto getnext
End If ' end of nameu check
End If ' eNode.GetAttribute(ID_ATTR
End If ' eNode.NumberOfChildNodes > 0
Next ' for all shapeList.NumberOfEntries
getnext:
Next ' for all in VDXElementArray
Exit Function
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("processShapes - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Function
Sub ExportVDXtoPDF(docPEP As NotesDocument)
Dim NDocConverter As Variant
Dim visioDoc As Variant
Dim appVisioV As Variant, docObjV As Variant, dbPath As Variant
Dim out As Integer
Dim rv As Integer
Dim redir As String
Dim rtitem As NotesRichTextItem
Dim object As NotesEmbeddedObject
Dim serv As NotesName
Dim pdfdoc As NotesDocument
Set serv = New NotesName(db.Server)
Dim source As String, fs As String, bs As String
'Delcare error handling for entire script
On Error Goto Errorhandler
Set appVisioV = CreateObject("Visio.Applic
Set docObjV = appVisioV.Documents.Open(o
Set visioDoc = appVisioV.Documents.Item(1
out = visioDoc.Saveas(OutputVSD)
appVisioV.Quit 'Close Visio
'Convert document to PDF
Set NDocConverter = createObject("docConverter
rv = NDocConverter.SubmitFile(O
rv=2
While rv=2
rv = NDocConverter.CheckStatus(
Doevents
NDocConverter.doSleep(1000
Wend
If rv=0 Then
Msgbox" ***************successfull
'Add PDF as attachment to web doc.
Set pdfdoc = db.CreateDocument()
pdfdoc.form = "PDFs"
Set rtitem = New NotesRichTextItem( pdfdoc, "Body" )
Set object = rtitem.EmbedObject ( EMBED_ATTACHMENT, "", OutputPDF)
Call pdfdoc.Save( True, True )
source = db.FilePath
fs="/"
bs="\"
dbpath= Replace(source,bs,fs)
redir = "/intranet/db.nsf/3coltabl
'pdfURL= "http://" + serv.Common +redir + dbpath + "/0/" + docPEP.DocUNID(0) + "/$File/"+object.Source
pdfURL= "http://" + serv.Common +"/"+dbpath + "/0/" + Cstr(pdfdoc.UniversalID) + "/$File/"+object.Source
Msgbox pdfURL
Else
Msgbox" *************error converting***************"
End If
Exit Sub
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("ExportVDXtoPDF - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Sub
Function KillTempFiles
Dim o As NotesEmbeddedObject
'Delcare error handling for entire script
On Error Goto Errorhandler
Kill OrigXML
Kill outputXML
Kill outputVSD
Kill outputPDF
Exit Function
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("KillTempFiles - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Function
Sub PublishPDFtoWeb(docPEP As NotesDocument)
Dim i As Integer
'Delcare error handling for entire script
On Error Goto Errorhandler
pdfhtml = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">"
pdfhtml=pdfhtml+"<html><he
pdfhtml=pdfhtml+"<title>OS
pdfhtml=pdfhtml+"</head><b
pdfhtml=pdfhtml+"<table border=""2"" width=""100%"" bordercolor=""#000099"" bordercolorlight=""#000099
pdfhtml=pdfhtml+"<tr><td width=""100%"">"
pdfhtml=pdfhtml+"<P ALIGN=center><IFRAME SRC=""" +pdfURL+""" WIDTH=""100%"" HEIGHT=750 FRAMEBORDER=0></IFRAME></P
pdfhtml=pdfhtml+"</tr></ta
Exit Sub
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("PublishPDFtoWeb - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Sub
that's IT.......
Make sure your security on your agent is set to:
Run as Web user
Runtime security is set to 3.allow restricted operations with full administrative rights.
and that your domino NT Service is run as an acount that can Read/Write/Delete files in the the VDXcache directory
Useful links are as follows:
Enjoy....
Firstly sorry for the delay in getting this to you.
My solution requires a wee bit of OLE to be honest for the .VDX(Visio XML document)->.VSD file conversion and the final conversion to PDF format. However the latter OLE option is avoidable with the use of the DocConverter Product that I have adopted to use here. Ref. http://www.neevia.com/prodDC.htm
The conversion to VSD is only required since a lot of third party conversion
There are a few prerequisits to implementing this solution.
These are as follows.
1. The client browser viewing the resultant output has a Visio viewer active X component and Adobe Acrobat 5 incstalled at least.
2. The Domino server should be R6.x at least as the code required to parse XML via lotuscript is only available in R6.
3. The Domino Server should have the MS Visio 2003 installed for the VDX to VSD conversion.
4. The Domino Server should have the DocConverter Product installed for the VSD to PDF conversion.
Scenario:
We have a web form to capture our user's data that we wish to transpose onto our Visio/pdf output diagram.
Requirements:
Create the Visio diagram that you wish to use as the template for the output visio diagram. Once you have pupolated all the shapes with their titles and defined the text areas that will be updated, save the file in VSD format and also in VDX format.
Now open up the VDX file in IE5 and you will see the XML document produced. This is what you will be working with when you parse the XML within the document.
The key Node Elements that you will be dealing with are as follows:
VisioDocument
Pages
Page
Shapes
Shape
The web form's fields text data will be used to populate specific shapes and the text therein.
Each field in the web form requires to be mapped to a specific shape on the diagram.
Get shape ID's:
By openning and selecting each shape in your visio diagram, you will be able to get each shapes ID number.
You should then create a keyword lookup form and views for this purpose.
the data I Used is as follows:
Web Form Field Name:
VDX File Elements:-
Element Name:
Element ID Attribute:
Element NameU Attribute: .
(for check box only : Checkbox ID Attribute:)
For Divided Process shape only : Divided Process Element ID: of the shape in the Divided process that holds that text you wish to change.)
Once you have completed creating your mapping documents with a corresponding lookup views(which I'll leave upto your discretion),
then create a VDX template form to hold your VDX template which will be used to create your populated VDX diagram, and resultant PDF file.
The agent code that I used for generating VISIO based PDFs is as follows:
(Options)
Option Public
Option Declare
(Declarations)
REM Constants found in a Notes names.nsf DXL file
REM Node names
Const DOCUMENT_NODE_NAME = "VisioDocument"
Const PAGES_NODE_NAME = "Pages"
Const PAGE_NODE_NAME = "Page"
Const SHAPES_NODE_NAME = "Shapes"
Const SHAPE_NODE_NAME = "Shape"
REM Attribute names
Const ID_ATTR_NAME = "ID"
Const NAMEU_ATTR_NAME = "NameU"
REM Attribute values
Const ID = "ID"
Const NAMEU = "NameU"
' Arrays for Fieldto VDX Element mapping
Dim FieldArray() As String
Dim VDXElementArray() As String
Dim docList As NotesDOMNodeList 'list of <VisioDocument> nodes
Dim pagesList As NotesDOMNodeList 'list of <Pages> nodes
Dim pageList As NotesDOMNodeList 'list of <Page> nodes
Dim shapesList As NotesDOMNodeList 'list of <Shapes> nodes
Dim shapeList As NotesDOMNodeList 'list of <Shape> nodes
Dim subshapeList As NotesDOMNodeList 'list of <Shapes/shape> nodes
Dim actList As NotesDOMNodeList 'list of <Act> nodes
Dim itemList As NotesDOMNodeList 'list of <item> nodes
Dim userList As NotesDOMNodeList 'list of <user> nodes
Dim eNode As NotesDOMElementNode 'a <document form= > node
Dim iNode As NotesDOMNode 'an <item> node
Dim txtNode As NotesDOMNode ' an <text> node
Dim textChild As NotesDOMNode 'the actual data value
Dim tNode As NotesDOMElementNode 'a <text> node; where we append new text data
Dim attrNode As NotesDOMAttributeNode 'attributes of <item> node
Dim attrs As NotesDOMNamedNodeMap
Dim numChildren As Integer
Dim iAttr As Integer 'attribute counter
Dim AttrVal As Variant
Dim iDoc As Integer 'counter for docList
Dim wDoc As Integer 'counter for docList
Dim yDoc As Integer 'counter for docList
Dim zDoc As Integer 'counter for docList
Dim tDoc As Integer 'counter for docList
Dim subDoc As Integer ' counter for subshapelist
Dim actDoc As Integer ' counter for actList
Dim userDoc As Integer ' Counter for userlist
Dim iItem As Integer 'counter for itemList
Dim newData As String 'user input
Dim newChild As NotesDOMNode 'node used for the append operation
Dim m As Integer 'match list counter
Dim v As Integer ' vdxarray counter
Dim i As Integer ' pointer to first | in VDX Array entry.
Dim n As Long
Dim domParser As NotesDOMParser
Dim docNode As NotesDOMDocumentNode
Dim rootElement As NotesDOMElementNode
Dim session As NotesSession
Dim inputStream As NotesStream
Dim outputStream As NotesStream, outputLog As NotesStream
Dim origXML As String, reportFile As String, logFile As String, outputXML As String
Dim outputVSD As String, outputPDF As String
Dim pdfURL As String
Dim NL As String 'carriage return + line feed
Dim LF As String '
Dim view As NotesView
Dim object As NotesEmbeddedObject
Dim db As NotesDatabase
Dim pdfhtml As String
(Initialise)
Sub Initialize
Dim xdoc As NotesDocument
Dim vwPEP As NotesView
Dim docPEP As NotesDocument
Dim queryString As String
Dim unid As String
Dim userName As String
Dim action As String
Dim startUNID As Integer
Dim startName As Integer
Dim rest As String
Dim tmp As String
Dim map As String
'Delcare error handling for entire script
On Error Goto Errorhandler
Set session = New NotesSession
Set db = session.currentdatabase
Set vwPEP = db.GetView("PEPbyUniqueId"
Set xdoc = session.DocumentContext
' Call xdoc.Save(True, False)
queryString$ = xdoc.Query_String(0)
unid$ = getParm(queryString$, "UNID") ' The unique ID for the DocumentContext.
map$ = getParm(queryString$, "map") 'The diagram type flag.
Set docPEP = vwPEP.GetDocumentByKey( unid$ )
If docPEP Is Nothing Then
Print "Unable to find document " + unid$
Exit Sub
End If
Call getVDXTemplate(map$)
Call CollectPEPData(docPEP, map$)
Call UpdateVDX
Call ExportVDXtoPDF(docPEP)
Call KillTempFiles
Call PublishPDFtoWeb(docPEP)
Print pdfhtml
Exit Sub
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("Initialize - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Sub
Sub GetVDXTemplate(mapType As String)
'Delcare error handling for entire script
On Error Goto Errorhandler
Dim rtitem As Variant
Dim inputFullpath As String
Dim outputFullpath As String
Dim filepath As Variant
Dim PDFOutput As Variant, tmp As Variant
Dim datestr As Variant
Dim item As NotesItem
Dim tView As NotesView
Dim tmpltDoc As NotesDocument
Dim timestamp As New NotesDateTime(Now)
'#########################
' This sub is used to get the correct VDX template for the MAP option specified and extract this file to the
' \\server.domain.local\E$\L
'under a timestamped renamed version of the file.
'This file path is then used by OrigXML and the InputStream in the UpdateVDX sub to facilitate parsing of the unique VDX file
'prior to conversion to PDF
'#########################
'Get the timestamp for this instant
datestr = Cstr(Format(timestamp.lsLo
'Get the correct VDX file template
Set tView = db.getView("vdxtemplate")
If Not (tView Is Nothing) Then
Select Case(mapType)
Case "RoadMap" :
tmp = "VDXRoadMapTemplate"
Case "Concept" :
tmp = "Phase1Template"
Case "Feasibility" :
tmp = "Phase2Template"
Case "Development" :
tmp = "Phase3Template"
Case "Implementation" :
tmp = "Phase4Template"
Case "Termination" :
tmp = "Phase5Template"
End Select
Set tmpltDoc = tView.GetDocumentByKey(tmp
If Not (tmpltDoc Is Nothing) Then
Set object = tmpltDoc.GetAttachment( tmpltDoc.Att_name(0) )
If Not (object Is Nothing) Then
'Get unc filepath for vdxcache directory on Server to hold the VDX file
If ( object.Type = EMBED_ATTACHMENT ) Then
'Specify the full path of the xml file that will be updated with PEP information
filepath = getParameter("vdxcache")
PDFOutput = getParameter("PDFDirectory
OrigXML = Cstr(filepath(0))+datestr+
outputXML = Cstr(filepath(0))+datestr+
outputVSD = Replace(outputXML,".vdx","
outputPDF = Replace(Cstr(PDFOutput(0))
'Update OrigXML for Inputstream process in UpdateVDX sub
' Extract the file to the SSYDAPP01
' (Domino Server running as account with read/write access to the file system)
Call object.ExtractFile(OrigXML
Call object.ExtractFile(outputX
End If
End If
End If
End If
Exit Sub
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("GetVDXTemplate - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Sub
Sub CollectWebformData (Webdoc As NotesDocument, map As String)
Dim webfield As Variant
Dim webvalue As Variant
Dim ElementName As Variant
Dim ID As Variant
Dim NameU As String
Dim DPShapeID As Variant
Dim NameU_All As Variant
'Collect all vdx mapping documents as redim each array with the collection.count
'parse through the web document and assign each updated field to the correct VDX mapping value
'Open web field to VDX element mapping view
Dim VDXmapping As NotesView
Dim vdxmapdoc As NotesDocument
Dim i As Integer ' - counter for vdxmapdoc
Dim x As Integer
'Delcare error handling for entire script
On Error Goto Errorhandler
'Update the above arrays with data from web prior to passing stored values to the corresponding VDX element
' initialise counter
i=0
'Parse though mapping and update the arrays with data that is held in the respective fields
Set VDXmapping=db.GetView("vdx
Set vdxmapdoc = VDXmapping.GetFirstDocumen
While Not vdxmapdoc Is Nothing
webfield = vdxmapdoc.GetItemValue("we
webvalue = PEPdoc.GetItemValue(webfie
'if Other specified for Tasks, pick the other data entered
If webvalue(0)="Other" Then
pepvalue = PEPdoc.GetItemValue(webfie
End If
If Ubound(webvalue) > 0 Then
For x=1 To Ubound(webvalue)
webvalue(0) = webvalue(0) + "|" + webvalue(x)
Next
Redim Preserve webvalue(0)
End If
'web value to populate in FieldArray
If Not (webvalue(0)="") Then
Redim Preserve FieldArray(i)
FieldArray(i) = webvalue(0)
ElementName = vdxmapdoc.GetItemValue("El
ID = vdxmapdoc.GetItemValue("ID
NameU_All = vdxmapdoc.GetItemValue("Na
DPShapeID = vdxmapdoc.GetItemValue("DP
Redim Preserve VDXElementArray(i)
If Not DPShapeID(0) = "" Then
VDXElementArray(i) = ElementName(0)+"|"+ID(0)+"
i=i+1
Else
VDXElementArray(i) = ElementName(0)+"|"+ID(0)+"
i=i+1
End If
End If
Set vdxmapdoc = VDXmapping.GetNextDocument
Wend
Exit Sub
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("CollectPEPData - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Sub
Sub UpdateVDX
'#########################
' This sub is used to parse the VDX inputStream file XML object and update the outputStream file
'The principle fucntionality is held in processShapes
'#########################
Dim id As String
Dim nameu As String
'Delcare error handling for entire script
On Error Goto Errorhandler
If Not createFiles( "Update Contacts List") Then Exit Sub
'The following creates input and output streams
'Set notesDOMParser = notesSession.CreateDOMPars
Set domParser=session.CreateDO
domParser.Process
'Now the the XML is in Dom Parser, truncate the input file so that we can repopulate it with the updated xml
'inputStream.Truncate
Set docNode = domParser.Document
Set rootElement = domParser.Document.Documen
Set pagesList = rootElement.GetElementsByT
If pagesList.NumberOfEntries = 0 Then Exit Sub
For iDoc = 1 To pagesList.NumberOfEntries 'search <Pages...> nodes
Set eNode = pagesList.GetItem(iDoc)
If eNode.NumberOfChildNodes > 0 Then
REM Element name ='Pages'>
Set pageList = eNode.GetElementsByTagName
If pageList.NumberOfEntries = 0 Then Exit Sub
For wDoc = 1 To pageList.NumberOfEntries 'search <Page...> nodes
Set eNode = pageList.GetItem(wDoc)
If eNode.NumberOfChildNodes > 0 Then
REM Element name ='Pages'>
Set shapeList = eNode.GetElementsByTagName
If shapeList.NumberOfEntries = 0 Then Exit Sub
Call processshapes
End If ' if pagelist.NumberOfEntries >0
Next ' - Get all in pageList
End If ' - pagesList.NumberOfEntries > 0
Next ' - Get all in pagesList
'Walks the DOM document tree and streams the resulting XML to the DOM parser's output object, provided one was specified.
Call domParser.Serialize()
Call inputStream.Close
Call outputStream.Close
Exit Sub
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("UpdateVDX - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Sub
Function createFiles(title As String)
'#########################
' This function creates the NotesStream to the VDX files on
' \\server.domain.local\E$\L
' for input and output and outputlog( as applicable)
'#########################
'Delcare error handling for entire script
On Error Goto Errorhandler
createFiles = True
'create the output file
Set outputStream = session.CreateStream
outputStream.Open (outputXML)
outputStream.Truncate
'open the input XML file
Set inputStream = session.CreateStream
inputStream.Open (origXML)
If inputStream.Bytes = 0 Then createFiles = False
Exit Function
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print(" createFiles - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Function
Function processShapes
Dim id As String
Dim nameu As String
Dim dpshapeid As String
Dim tVal As String
Dim rkVal As String
Dim rVal As String
Dim offset As Long
'Delcare error handling for entire script
On Error Goto Errorhandler
NL = Chr(13) + Chr(10)
'Now we parse through the VDXElementArray to get the ID and NameU attributes
For v=0 To Ubound(VDXElementArray)
i = Instr(VDXElementArray(v),"
n = Instr(i+1,VDXElementArray(
m = Instr(n+1,VDXElementArray(
id = Mid(VDXElementArray(v),i+1
If m<=0 Then
nameu = Mid(VDXElementArray(v),n+1
Elseif m>0 Then
nameu = Mid(VDXElementArray(v),n+1
'Get the Divided Process Shape ID with text to update
dpshapeid = Mid(VDXElementArray(v),m+1
'******************replace
id = dpshapeid
'*************************
End If
For zDoc = 1 To shapeList.NumberOfEntries 'search <Shape...> nodes
Set eNode = shapeList.GetItem(zDoc)
If eNode.NumberOfChildNodes > 0 Then
If eNode.GetAttribute(ID_ATTR
If Instr(nameu,"Check box") >0 Then
Set actList = eNode.GetElementsByTagName
Set subshapeList = eNode.GetElementsByTagName
Set userList = eNode.GetElementsByTagName
If actList.NumberOfEntries = 0 Then Exit Function
If subshapeList.NumberOfEntri
If userList.NumberOfEntries = 0 Then Exit Function
For actDoc= 1 To actList.NumberOfEntries 'search <Act...> nodes
Set eNode = actList.GetItem(actDoc)
Select Case eNode.GetAttribute("IX")
Case 0 : ' Set Shading Case 1 :
'_Unchecked action - This is the Text Child Node for _unchecked node
Set textChild = eNode.Firstchild.NextSibli
rkVal = textChild.NodeValue
textchild.NodeValue = "0"
Case 2 :
' Checked action - This is the Text Child Node for checked node
Set textChild = eNode.Firstchild.NextSibli
rkVal = textChild.NodeValue
textchild.NodeValue = "1"
Case 3 : 'Cross Mark
End Select
Next
For userDoc= 1 To userList.NumberOfEntries 'search <User...> nodes
Set eNode = userList.GetItem(userDoc)
Set textChild = eNode.Firstchild.NextSibli
rkVal = textChild.NodeValue
textchild.NodeValue = "1"
Next
For subDoc= 1 To subshapeList.NumberOfEntri
Set eNode = subshapeList.GetItem(subDo
Select Case eNode.GetAttribute("Master
Case 11 :
'NoShow Node - This is the Text Child Node for checked node
Set textChild = eNode.LastChild.PreviousSi
textchild.NodeValue = "0"
End Select
Next
Goto getnext
Else
tVal = FieldArray(v)
Set textchild = eNode.lastchild ' Must now get Previous sibling as this is the text node
Set txtNode = textchild.PreviousSibling ' this is the text node
Set textChild = txtNode.Firstchild ' This is the Text Child Node hold
If textChild.NodeName = "pp" Or textChild.NodeName = "cp" Then '
Set textChild = textchild.NextSibling ' this is the text node
End If
rkVal = textChild.NodeValue
If Instr(rkVal,"Goal:")>0Then
textchild.NodeValue = "Goal: "+FieldArray(v)
Elseif Instr(tVal," - Select -")>0 Then
textchild.NodeValue = ""
Elseif Instr(rkVal,"ROAD PLAN")>0 Then
textchild.NodeValue = "ROADMAP "+FieldArray(v) + " - Published "+ Format(Now,"dd/mm/yyyy")
Elseif Instr(rkVal,"Executive Names")>0 And Instr(tVal,"|")>0 Then
rVal = Replace(FieldArray(v),"|",
textchild.NodeValue = rVal
Elseif Instr(rkVal,"Project Team Names")>0 And Instr(tVal,"|")>0 Then
rVal = Replace(FieldArray(v),"|",
textchild.NodeValue = rVal
Elseif Instr(rkVal,"No Data")>0 And Instr(tVal,"|")>0 Then
rVal = Replace(FieldArray(v),"|",
textchild.NodeValue = rVal
Else
textchild.NodeValue = FieldArray(v)
End If
rkVal = textChild.NodeValue
Goto getnext
End If ' end of nameu check
End If ' eNode.GetAttribute(ID_ATTR
End If ' eNode.NumberOfChildNodes > 0
Next ' for all shapeList.NumberOfEntries
getnext:
Next ' for all in VDXElementArray
Exit Function
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("processShapes - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Function
Sub ExportVDXtoPDF(docPEP As NotesDocument)
Dim NDocConverter As Variant
Dim visioDoc As Variant
Dim appVisioV As Variant, docObjV As Variant, dbPath As Variant
Dim out As Integer
Dim rv As Integer
Dim redir As String
Dim rtitem As NotesRichTextItem
Dim object As NotesEmbeddedObject
Dim serv As NotesName
Dim pdfdoc As NotesDocument
Set serv = New NotesName(db.Server)
Dim source As String, fs As String, bs As String
'Delcare error handling for entire script
On Error Goto Errorhandler
Set appVisioV = CreateObject("Visio.Applic
Set docObjV = appVisioV.Documents.Open(o
Set visioDoc = appVisioV.Documents.Item(1
out = visioDoc.Saveas(OutputVSD)
appVisioV.Quit 'Close Visio
'Convert document to PDF
Set NDocConverter = createObject("docConverter
rv = NDocConverter.SubmitFile(O
rv=2
While rv=2
rv = NDocConverter.CheckStatus(
Doevents
NDocConverter.doSleep(1000
Wend
If rv=0 Then
Msgbox" ***************successfull
'Add PDF as attachment to web doc.
Set pdfdoc = db.CreateDocument()
pdfdoc.form = "PDFs"
Set rtitem = New NotesRichTextItem( pdfdoc, "Body" )
Set object = rtitem.EmbedObject ( EMBED_ATTACHMENT, "", OutputPDF)
Call pdfdoc.Save( True, True )
source = db.FilePath
fs="/"
bs="\"
dbpath= Replace(source,bs,fs)
redir = "/intranet/db.nsf/3coltabl
'pdfURL= "http://" + serv.Common +redir + dbpath + "/0/" + docPEP.DocUNID(0) + "/$File/"+object.Source
pdfURL= "http://" + serv.Common +"/"+dbpath + "/0/" + Cstr(pdfdoc.UniversalID) + "/$File/"+object.Source
Msgbox pdfURL
Else
Msgbox" *************error converting***************"
End If
Exit Sub
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("ExportVDXtoPDF - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Sub
Function KillTempFiles
Dim o As NotesEmbeddedObject
'Delcare error handling for entire script
On Error Goto Errorhandler
Kill OrigXML
Kill outputXML
Kill outputVSD
Kill outputPDF
Exit Function
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("KillTempFiles - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Function
Sub PublishPDFtoWeb(docPEP As NotesDocument)
Dim i As Integer
'Delcare error handling for entire script
On Error Goto Errorhandler
pdfhtml = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">"
pdfhtml=pdfhtml+"<html><he
pdfhtml=pdfhtml+"<title>OS
pdfhtml=pdfhtml+"</head><b
pdfhtml=pdfhtml+"<table border=""2"" width=""100%"" bordercolor=""#000099"" bordercolorlight=""#000099
pdfhtml=pdfhtml+"<tr><td width=""100%"">"
pdfhtml=pdfhtml+"<P ALIGN=center><IFRAME SRC=""" +pdfURL+""" WIDTH=""100%"" HEIGHT=750 FRAMEBORDER=0></IFRAME></P
pdfhtml=pdfhtml+"</tr></ta
Exit Sub
ErrorHandler:
'Use the Err function to return the error number and the Error$ function to return the error message.
Print("PublishPDFtoWeb - Error Number " + Cstr(Err) + " : " + Error$ + " on line number " + Cstr(Erl))
Resume Next 'Continue where the agent encountered the last error
End Sub
that's IT.......
Make sure your security on your agent is set to:
Run as Web user
Runtime security is set to 3.allow restricted operations with full administrative rights.
and that your domino NT Service is run as an acount that can Read/Write/Delete files in the the VDXcache directory
Useful links are as follows:
Enjoy....
ASKER
Links are:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/devref/HTML/XMLR_XMLBasics_817.asp
http://www.neevia.com/prodDC.htm
And the invaluable Domino Designer R6 help.
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/devref/HTML/XMLR_XMLBasics_817.asp
http://www.neevia.com/prodDC.htm
And the invaluable Domino Designer R6 help.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Tom