Here is a small sub that creates an xml file of all the fields available in a document that it is passed.
This code could be improved to accept a field name for where to attach the document. In the code below, I attach it to a field called Attachments_Information.
Sub CreateXMLDocument(db As Notesdatabase, doc As notesdocument)
On Error GoTo error_handle
Dim noteid As String, strKey As String, strForm As String,strField As String, strFilename As String
Dim vw As NotesView
Dim docField As NotesDocument
Dim dc As NotesDocumentCollection
Dim rtitem As NotesRichTextItem
Dim object As NotesEmbeddedObject
Dim xml As XMLProcessor
Dim docNode As NotesDOMElementNode
Set xml = New XMLProcessor("Documents")
Set docNode = xml.appendElementNode(Nothing, "Document", "", "") 'if parent node is Nothing then root node will be used as parent node
strForm = doc.Form(0)
If strForm="General" Then
strKey="General Enquiry"
Else
strKey=strForm
End If
Set vw = db.GetView( "VeSFieldsByForm" )
Set dc = vw.GetAllDocumentsByKey(strKey, False)
Set docField = dc.Getfirstdocument()
While Not docField Is Nothing
strField= docField.FieldName(0)
Call xml.appendElementNode(docNode, strField, doc.GetItemValue( strField )(0), "")
Set docField = dc.Getnextdocument(docField)
Wend
strFilename = "e:\lotus\domino\data\Document.xml"
Call xml.toFile(strFilename)
Set rtitem = doc.GetFirstItem( "Attachments_Information" )
If ( rtitem Is Nothing ) Then
Set rtitem = New NotesRichTextItem( doc, "Attachments_Information" )
elseIf Not ( rtitem.Type = RICHTEXT ) Then
Set rtitem = New NotesRichTextItem( doc, "Attachments_Information" )
End If
Set object = rtitem.EmbedObject ( EMBED_ATTACHMENT, "", strFilename)
Call doc.Save( True, True )
ex_sub:
Exit Sub
error_handle:
On Error Resume Next
Print "(CreateXMLDocument): " + Error$ + ". Line: " + Str$(Erl())
Resume ex_sub
End Sub
No comments:
Post a Comment