Accéder au contenu principal

Générer du XML depuis VBA

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, "&", "&amp;") 'do ampersand first !  
     sValue = Replace(sValue, "'", "&apos;")  
     sValue = Replace(sValue, """", "&quot;")  
     sValue = Replace(sValue, "<", "&lt;")  
     sValue = Replace(sValue, ">", "&gt;")  
     CleanupStr = sValue  
   End If  
 End Function 

Commentaires

Posts les plus consultés de ce blog

ROW_NUMBER OVER PARTITION en Access

Ceux qui ont l'habitude de travailler avec une "grosse" base données comme SQL Server / Oracle / PostGreSQL, sont parfois frustrés face à certaines lacunes du SQL d'Access.   Prenons par exemple: ROW_NUMBER() OVER PARTITION, dont l'absence rend certaines requêtes très compliquées.   J'ai donc écrit une petite fonction VBA qui peut être appelée depuis un query Access et qui simulera assez bien ce ROW_NUMBER() OVER PARTITION.   Notez que ceci ne fonctionnera pas correctement dans une vue ou un formulaire interactif. Par contre comme source d'un rapport ou d'un export Excel, c'est impeccable.   En pratique il est préférable d'initialiser la fonction avec une chaîne de caractères "improbable" avant de lancer le rapport, comme indiqué dans le code.

Calculate MAX of a list in VBA

Strangely such a function is not available in VBA. Here is one that works with any number of strings or numbers. Function Largest(ParamArray a() As Variant) As Variant 'returns the largest element of list 'List is supposed to be consistent: all nummbers, dates, strings. 'Nulls are allowed, but not in first position. Eventually provide a first low dummy value 'e.g:   largest(2,6,-9,7,3)         -> 7 '       largest("d", "z", "c", "x") -> "z" 'by Patrick Honorez --- www.idevlop.com     Dim result As Variant     Dim i As Integer          result = a(LBound(a))          For i = LBound(a) + 1 To UBound(a)         If result < Nz(a(i), result) Then             result = a(i)         End If     Next i     Largest = result End Function