Après avoir testé plusieurs solutions, j'ai fini par conclure que le plus simple pour générer du XML était de créer mes propres routines. Voici quelques fonctions très utiles pour générer du XML:
Function fRsToXml(rs As Recordset, Optional ignorePrefix As String = "zz", _
Optional ignoreNulls As Boolean = False) As String
'description: Returns an XML string with all fields of the current record,
' using field names as tags.
' Field names starting with "zz" (or other special prefix) are ignored
'parameters: rs: recordset (byRef, of course)
'author: Patrick Honorez - www.idevlop.com
Dim f As Field, bPrefLen As Byte
Dim strResult As String
bPrefLen = Len(ignorePrefix)
For Each f In rs.Fields
If Left(f.Name, bPrefLen) <> ignorePrefix Then 'zz fields are ignored !
If (Not ignoreNulls) Or (ignoreNulls And Not IsNull(f.Value)) Then
strResult = strResult & xTag(f.Name, f.Value) & vbCrLf
End If
End If
Next f
fRsToXml = strResult
End Function
Function xTag(ByVal sTagName As String, ByVal sValue, Optional SplitLines As Boolean = False) As String
'description: Create an xml node and returns it as a string
'parameters: sTagName name of the tag
' sValue string to embed
' SplitLine True to include CrLf at the end of each line
' (optional - default = False)
'author: Patrick Honorez - www.idevlop.com
'note: Make sure sValue does not contains XML forbidden characters !
Dim strNl As String, intAmp
If SplitLines Then
strNl = vbCrLf
Else
strNl = vbNullString
End If
xTag = "<" & sTagName & ">;" & strNl & _
Nz(sValue, "") & strNl & _
"</" & sTagName & ">" '& strNl
End Function
Function CleanupStr(strXmlValue) As String
'description: Replace forbidden char. &'"<> by their Predefined General Entities
'author: Patrick Honorez - www.idevlop.com
Dim sValue As String
If IsNull(strXmlValue) Then
CleanupStr = ""
Else
sValue = CStr(strXmlValue)
sValue = Replace(sValue, "&", "&") 'do ampersand first !
sValue = Replace(sValue, "'", "'")
sValue = Replace(sValue, """", """)
sValue = Replace(sValue, "<", "<")
sValue = Replace(sValue, ">", ">")
CleanupStr = sValue
End If
End Function