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
Libellés :

Commentaires

Enregistrer un commentaire

Posts les plus consultés de ce blog

Champs obligatoires dans un formulaire Access

Comment rendre des champs obligatoires dans un formulaire Access ? La réponse la plus évidente est de modifier le design de la table et d'assigner au paramètre Required la valeur True. L'ennui de cette méthode est que le message d'erreur d'Access n'est pas très convivial et ne spécifie pas quel champ a déclenché l'erreur. Plutôt que d'écrire une routine de gestion d'erreur complexe, il y a une solution toute simple: affecter la valeur Faux à la propriété  Required du champ, Validation Rule: Is Not Null Validation Text: le texte à afficher, ex: "Code Postal obligatoire" ..et le tour est joué. Cette astuce vient de l'excellent Allen Browne, dont le site (en anglais) regorge d'informations utiles sur Access. ps: je n'ai pas sous la main de version française d'Access pour la traduction des propriétés, désolé...
Enregistrer un commentaire
Lire la suite

Remplir une ListBox Access

Pour remplir une ListBox MS Access avec des données provenant d'un recordset, il suffit généralement de définir une rowSourceType = Table et de donner le nom de la table ou de la requête. Mais dans certains cas, il peut être préférable de fournir ces valeurs sous forme d'une ValueList. C'est le travail de la fonction ci-dessous. Sub FillList(ByRef lstBox As ListBox, strQry As String) 'fill combo with value list from recordset 'to be used when recordset is too slow to requery for sorting Dim rs As Recordset, strSrc As String, i As Integer Set rs = CurrentDb.OpenRecordset(strQry, dbOpenSnapshot) lstBox.RowSourceType = "Value list" lstBox.ColumnCount = rs.Fields.Count ReDim arSrc(rs.RecordCount * rs.Fields.Count) Do Until rs.EOF For i = 0 To rs.Fields.Count - 1 strSrc = strSrc & rs.Fields(i) & ";" Next i rs.MoveNext Loop lstBox.RowSource = Left(strSrc, Len(strSrc) - 1) End Sub
Enregistrer un commentaire
Lire la suite

Simuler un COUNT DISTINCT avec Access

Le SQL disponible dans les requêtes Access ne dispose pas de l'instruction COUNT DISTINCT, qui permettrait par exemple, de compte combien de clients différents ont commandé, année par année. Ce prédicat, qui est présent dans SQL Server, peut être simulé de diverses manières, plus ou moins lourdes et plus ou moins efficaces. Mais la méthode probablement la plus performante est d'utiliser une requête CROSSTAB un peu particulière. Voici  un exemple sur la base Northwind (ou Comptoirs avec les versions françaises d'Access), dans lequel on va décompter le nombre de clients différents par année, ainsi que le nombre total de commandes: TRANSFORM Count(*) AS Dist SELECT Year([OrderDate]) AS Yr, Count(([Dist])) AS DistCustomers, Count(OrderId) AS NumOrders FROM Orders AS o GROUP BY Year([OrderDate]) PIVOT CustId In (null); Pour la voir en action, vous pouvez créer une nouvelle requête dans Northwind, l'afficher en mode SQL, et y coller le code ci-dessus. Ce type de requ...
Enregistrer un commentaire
Lire la suite