Export SAX des docs selectionnés
Publié: 16 Fév 2007 à 14:24- Code : Tout sélectionner
Dim session As New NotesSession
Dim db As NotesDatabase
Set db = session.CurrentDatabase
'Build a NoteCollection to limit the export file to documents
Dim nc As NotesNoteCollection
Set nc = db.CreateNoteCollection(False)
nc.SelectDocuments=True
Call nc.BuildCollection
'Create the DXL exporter
Dim exporter As NotesDXLExporter
Set exporter = session.CreateDXLExporter(nc)
exporter.OutputDOCTYPE = False
'Create the output file
Dim xml_out As NotesStream
Set xml_out=session.CreateStream
filename$ = "c:\dxl\" + Left(db.FileName, Len(db.FileName) - 4) + "_sax.xml"
If Not xml_out.Open(filename$) Then
Messagebox "Cannot open " + filename$ + ". Check to make sure this directory exists.",, "Error"
Exit Sub
End If
Call xml_out.Truncate
'Create the SAX parser
Dim saxParser As NotesSAXParser
Set saxParser=session.CreateSAXParser(exporter, xml_out)
On Event SAX_Characters From saxParser Call SAXCharacters
On Event SAX_EndDocument From saxParser Call SAXEndDocument
On Event SAX_EndElement From saxParser Call SAXEndElement
On Event SAX_Error From saxParser Call SAXError
On Event SAX_FatalError From saxParser Call SAXFatalError
On Event SAX_IgnorableWhitespace From saxParser Call SAXIgnorableWhitespace
On Event SAX_NotationDecl From saxParser Call SAXNotationDecl
On Event SAX_ProcessingInstruction From saxParser Call SAXProcessingInstruction
On Event SAX_StartDocument From saxParser Call SAXStartDocument
On Event SAX_StartElement From saxParser Call SAXStartElement
On Event SAX_UnparsedEntityDecl From saxParser Call SAXUnparsedEntityDecl
On Event SAX_Warning From saxParser Call SAXWarning
exporter.Process
Sub SAXStartDocument (Source As Notessaxparser)
Source.Output({<?xml version='1.0' encoding='utf-8'?>})
End Sub
Sub SAXEndDocument (Source As Notessaxparser)
End Sub
Sub SAXCharacters (Source As Notessaxparser, Byval Characters As String,_
Count As Long)
If Characters <> Chr(10) Then
Source.Output(Characters)
End If
End Sub
Sub SAXEndElement (Source As Notessaxparser, Byval ElementName As String)
If ElementName = "databaseinfo" Then
Exit Sub
End If
If ElementName = "noteinfo" Then
Exit Sub
End If
If ElementName = "updatedby" Then
Exit Sub
End If
Source.Output({</} + ElementName + {>} + Chr(13)+Chr(10))
End Sub
Sub SAXError (Source As Notessaxparser, Exception As NotesSaxException )
Messagebox {Error - } + Exception.Message, MB_ICONINFORMATION
Source.Output ({Error - } + Exception.Message)
End Sub
Sub SAXFatalError (Source As Notessaxparser, Exception As NotesSaxException)
Messagebox {FatalError - } + Exception.Message, MB_ICONINFORMATION
Source.Output ({FatalError - } + Exception.Message)
End Sub
Sub SAXIgnorableWhitespace (Source As Notessaxparser,_
Byval characters As String, Count As Long)
End Sub
Sub SAXNotationDecl (Source As Notessaxparser,_
Byval NotationName As String, Byval publicid As String,_
Byval systemid As String)
End Sub
Sub SAXProcessingInstruction (Source As Notessaxparser,_
Byval target As String, Byval PIData As String)
End Sub
Sub SAXStartElement (Source As Notessaxparser, Byval ElementName As String, Attributes As NotesSaxAttributeList)
If ElementName = "databaseinfo" Then
Exit Sub
End If
If ElementName = "noteinfo" Then
Exit Sub
End If
If ElementName = "updatedby" Then
Exit Sub
End If
Dim i As Integer
Source.Output({<}+ ElementName)
If Attributes.Length > 0 Then
Dim attrname As String
For i = 1 To Attributes.Length
attrname = Attributes.GetName(i)
Source.Output({ } + attrname+{="}+Attributes.GetValue(attrname) + {"})
Next
End If
Source.Output({>})
End Sub
Sub SAXUnParsedEntityDecl (Source As Notessaxparser,_
Byval Entityname As String, Byval publicid As String,_
Byval systemid As String, Byval notationname As String)
End Sub
Sub SAXWarning (Source As Notessaxparser, Exception As NotesSaxException)
Source.Output({Warning - } + Exception.Message)
End Sub