1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources VB.NET
  5. Exemple d'utilisation du xml avec vb.net

Exemple d'utilisation du xml avec vb.net

Soyez le premier à donner votre avis sur cette source.

Vue 17 583 fois - Téléchargée 1 614 fois

Télécharger le projet
Commenter

Description

C'est une source très simple qui permettra au débutants de faire leur marques avec le XML dans VB.NET, ce code n'a pas la prétention d'être exhaustif mais il permet au moins de se faire une idée des propriétés et des méthodes disponibles.
Pour le reste tout est dans le zip...

ATTENTION
- Le format du zip est en 7-Zip
- L'application est en VB.NET 2010

Source / Exemple : 


Imports System.Xml
Imports System.IO
Imports System.Xml.XPath

Public Class fMain
    Dim sSampleXMLFile As String = Application.StartupPath & "\SampleXMLFile.xml"
    Dim sSampleQueryFile As String = Application.StartupPath & "\QueryOnXML.xml"

    ' Très bon tutorial sur XPAth http://jerome.developpez.com/xmlxsl/xpath/?lpage=exemples
    ' Exemple LINQ => http://msdn.microsoft.com/en-us/vbasic/bb688088.aspx

    Private Sub btCreateXML_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btCreateXML.Click
        ' This method shows how to build an XML file all from code.
        Dim xDoc As New XmlDocument

        Dim xPI As XmlProcessingInstruction
        Dim xComment As XmlComment
        Dim xElmntRoot As XmlElement
        Dim xElmntContent As XmlElement

        xPI = xDoc.CreateProcessingInstruction("xml", "version='1.0'")
        xDoc.AppendChild(xPI)

        ' Add a comment in start of document
        xComment = xDoc.CreateComment("Sample of a comment in a XML file")
        xDoc.AppendChild(xComment)

        xElmntRoot = xDoc.CreateElement("xml")
        xDoc.AppendChild(xElmntRoot)

        ' Create a root and a sub
        xElmntContent = xElmntRoot.AppendChild(xDoc.CreateElement("CHILD_1"))
        xElmntContent.AppendChild(xDoc.CreateElement("SUB_CHILD_1"))

        ' Create a root and a sub 2
        xElmntContent = xElmntRoot.AppendChild(xDoc.CreateElement("SECTION_2"))
        xElmntContent.AppendChild(xDoc.CreateElement("SUB_2"))

        ' Save document
        xDoc.Save(sSampleXMLFile)

        'Show doc
        btShowXMLDocument_Click(sender, e)
    End Sub

    Private Sub btShowXMLDocument_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btShowXMLDocument.Click
        'Shell("notepad " & sSampleXMLFile, AppWinStyle.NormalFocus)
        rtbXMLDocument.Clear()
        rtbXMLDocument.LoadFile(sSampleXMLFile, RichTextBoxStreamType.PlainText)
    End Sub

    Private Sub btAddElements_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btAddElements.Click
        Dim xDoc As New XmlDocument
        Dim xNode As XmlNode
        Dim xNodeTemp As XmlNode

        'Load XML document
        xDoc.Load(sSampleXMLFile)

        ' Select for a particular node
        xNode = xDoc.SelectSingleNode("//SUB_CHILD_1")
        ' Add a TAG content with text in SECTION_1_SUB_1 section
        xNodeTemp = xDoc.CreateElement("ELEMENT")
        xNodeTemp.AppendChild(xDoc.CreateTextNode("Sample of a text in a node"))
        xNode.AppendChild(xNodeTemp)

        ' Save file
        xDoc.Save(sSampleXMLFile)

        'Show doc
        btShowXMLDocument_Click(sender, e)
    End Sub

    Private Sub btAddAttributes_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btAddAttributes.Click
        ' This method will remove all child nodes of the Family 
        ' node and then re-add them with some attributes.
        ' It also shows how to manipulate existing attributes.
        Dim xDoc As New XmlDocument
        Dim xElem As XmlElement

        xDoc.Load(sSampleXMLFile)

        ' Select ELEMENT_1 and add one attribute
        xElem = xDoc.SelectSingleNode("//SUB_CHILD_1/ELEMENT")
        xElem.SetAttribute("Attribute_1", "Value of attribute 1")
        xElem.SetAttribute("Attribute_2", "Value of attribute the big attribute 2")

        ' Save file
        xDoc.Save(sSampleXMLFile)
        'Show doc
        btShowXMLDocument_Click(sender, e)
    End Sub

    Private Sub btModifyElements_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btModifyElements.Click
        Dim xDoc As New XmlDocument
        Dim xElem As XmlElement

        xDoc.Load(sSampleXMLFile)

        ' Select ELEMENT_1 and add one attribute
        xElem = xDoc.SelectSingleNode("//SUB_CHILD_1/ELEMENT")
        xElem.InnerText = "The new texte of the element"

        ' Save file
        xDoc.Save(sSampleXMLFile)
        'Show doc
        btShowXMLDocument_Click(sender, e)
    End Sub

    Private Sub btModifyAttributes_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btModifyAttributes.Click
        Dim xDoc As New XmlDocument
        Dim xElem As XmlElement

        xDoc.Load(sSampleXMLFile)

        ' Select ELEMENT_1 and add one attribute
        xElem = xDoc.SelectSingleNode("//SUB_CHILD_1/ELEMENT")
        xElem.SetAttribute("Attribute_1", "The new value of attribute 1")

        ' Save file
        xDoc.Save(sSampleXMLFile)
        'Show doc
        btShowXMLDocument_Click(sender, e)
    End Sub

    Private Sub btDeleteAttributes_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btDeleteAttributes.Click
        Dim xDoc As New XmlDocument
        Dim xElem As XmlElement

        xDoc.Load(sSampleXMLFile)

        ' Select ELEMENT_1 and add one attribute
        xElem = xDoc.SelectSingleNode("//SUB_CHILD_1/ELEMENT")
        xElem.RemoveAttribute("Attribute_1")

        ' Save file
        xDoc.Save(sSampleXMLFile)
        'Show doc
        btShowXMLDocument_Click(sender, e)
    End Sub

    Private Sub btDeleteElements_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btDeleteElements.Click
        Dim xDoc As New XmlDocument
        Dim xElem As XmlElement

        xDoc.Load(sSampleXMLFile)

        ' Select ELEMENT_1 and add one attribute
        xElem = xDoc.SelectSingleNode("//SUB_CHILD_1/ELEMENT")
        xElem.RemoveAll()

        ' Save file
        xDoc.Save(sSampleXMLFile)
        'Show doc
        btShowXMLDocument_Click(sender, e)
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btRecursiveItems.Click
        Dim xDoc As New XmlDocument
        Dim sWriter As New StringWriter
        Dim sArrayListOfNodes As New ArrayList

        xDoc.Load(sSampleXMLFile)

        ' Use a recursive function to visit all nodes.
        ParseTree(sArrayListOfNodes, xDoc, 0)

        rtbXMLDocument.Clear()
        For Each sNode In sArrayListOfNodes
            rtbXMLDocument.Text += sNode.ToString & vbCrLf
        Next
    End Sub

    Private Sub ParseTree(ByVal aArrNodes As ArrayList, ByVal xNode As XmlNode, ByVal iLevel As Integer)
        ' current node and convert it with spaces
        Dim s As New String(System.Convert.ToChar(vbTab), iLevel)
        ' Add node to collection
        aArrNodes.Add(s & xNode.NodeType.ToString & " Level : " & iLevel & " => Node name : " & xNode.Name.ToString)

        ' If the current node has children also run recursivity
        If xNode.HasChildNodes Then
            For Each xNodeLoop In xNode.ChildNodes
                ParseTree(aArrNodes, xNodeLoop, iLevel + 1)
            Next xNodeLoop
        End If
    End Sub

    Private Sub btGetElement_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btGetElement.Click
        Dim xpathDoc As XPathDocument
        Dim xmlNav As XPathNavigator
        Dim xmlNI As XPathNodeIterator

        xpathDoc = New XPathDocument(sSampleXMLFile)
        xmlNav = xpathDoc.CreateNavigator()

        xmlNI = xmlNav.Select("/xml/CHILD_1")

        rtbXMLDocument.Clear()
        While (xmlNI.MoveNext())
            rtbXMLDocument.Text += xmlNI.Current.Name & " : " & xmlNI.Current.Value
        End While
    End Sub

    Private Sub btGetAttribut_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btGetAttribut.Click
        Dim xDoc As New XmlDocument
        Dim xElem As XmlElement
        Dim xAttr As XmlAttribute

        xDoc.Load(sSampleXMLFile)

        ' Select ELEMENT_1 and add one attribute
        xElem = xDoc.SelectSingleNode("/xml/CHILD_1/SUB_CHILD_1/ELEMENT")

        rtbXMLDocument.Clear()
        For Each xAttr In xElem.Attributes
            rtbXMLDocument.Text += xAttr.Name & " : " & xAttr.Value & vbCrLf
        Next
    End Sub

    Private Sub fMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

    End Sub

    Private Sub btElementHasAttributes_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btElementHasAttributes.Click
        Dim xDoc As New XmlDocument
        Dim xElem As XmlElement

        xDoc.Load(sSampleXMLFile)

        ' Select ELEMENT_1 and add one attribute
        xElem = xDoc.SelectSingleNode("/xml/CHILD_1/SUB_CHILD_1/ELEMENT")
        rtbXMLDocument.Text += xElem.Name & " : " & xElem.HasAttribute("Attribute_1") & vbCrLf
    End Sub
End Class

Conclusion :


Il n'y a pas vraiment de conclusion à vous de vous faire une idée...
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
disashy
Messages postés
3
Date d'inscription
lundi 8 février 2010
Statut
Membre
Dernière intervention
29 juillet 2010
29 juil. 2010 à 02:05
Merci pour to precieux travail, Christian.
J'ai rentre to code dans un module, mais j'obtiens une erreur "compile?".

Mon code fonctionne bien chez moi mais pas au bureau, et l'apostrophe dans le chemin d'acces ne semble pas influencer l'execution(pas d'apostrophe au travail).
J'ai du recourir a code suivant, plus mecanique, qui fonctionne bien au travail: Je convertis xl en txt en inserrant les balises et je sauve le fichier txt sosu forme xml.

Code:
Option Explicit

Dim objDOM As DOMDocument

Sub CreationFichier01()
'Définit la Range de cellules qui va servir pour la création du
'fichier xml.
'La première ligne du tableau est supposée contenir les entêtes
'(sans espaces ni caractères spéciaux).
CreationFichierXML ActiveSheet.Range("A1:F6")
End Sub
Sub CreationFichierXML(Range As Range)
'
'Nécessite d'activer la référence "Microsoft XML, V..."
'
Dim XnodeRoot As IXMLDOMElement, oNode As IXMLDOMNode
Dim XName As IXMLDOMElement
Dim XNameChild As IXMLDOMCDATASection
Dim Cmt As IXMLDOMComment
Dim Head As Range, Cell As Range
Dim I As Integer, j As Integer
Dim xmlDoc As New DOMDocument40
Dim rdr As New SAXXMLReader40
Dim wrt As New MXXMLWriter40

Set Head = Range.Rows(1)
Set Range = Range.Offset(1, 0).Resize(Range.Rows.Count - 1, Range.Columns.Count)

'----
Set objDOM = New DOMDocument

'Ajoute un commentaire qui reprend le nom de l'utilisateur et
' la date du jour.
Set Cmt = objDOM.createComment("Converted by " & Environ("username") & ", " & Date)
Set Cmt = objDOM.insertBefore(Cmt, objDOM.childNodes.Item(0))


'Type de fichier
Set oNode = objDOM.createProcessingInstruction("xml", "version='1.0' encoding='ISO-8859-1'")
Set oNode = objDOM.insertBefore(oNode, objDOM.childNodes.Item(0))
'----


Set XnodeRoot = objDOM.createElement("markers")
objDOM.appendChild XnodeRoot


'Boucle sur les données du tableau
For j = 2 To Range.Rows.Count

Set XName = objDOM.createElement("marker")
For I = 1 To Head.Columns.Count
XName.setAttribute Head.Cells(1, I), Range.Cells(j - 1, I)
Next I

XnodeRoot.appendChild XName

Next j


objDOM.Save "C:\Users\Tex'Ance\Desktop\macroParfaitFichier01.xml"

Set XnodeRoot = Nothing
Set objDOM = Nothing



'Load the DOM document.
xmlDoc.async = False
xmlDoc.resolveExternals = False
xmlDoc.Load "C:\Users\Tex'Ance\Desktop\macroParfaitFichier01.xml"

'Set properties on the XML writer.
wrt.byteOrderMark = True
wrt.omitXMLDeclaration = False
wrt.indent = True

'Set the XML writer to the SAX content handler.
Set rdr.contentHandler = wrt
Set rdr.dtdHandler = wrt
Set rdr.errorHandler = wrt

'Parse the DOMDocument object.
rdr.Parse xmlDoc
MsgBox wrt.output
xmlDoc.loadXML wrt.output
xmlDoc.Save "C:\Users\Tex'Ance\Desktop\macroParfait_Fichier01.xml"
End Sub

Sub CreationElement(strElem As String, Data As Variant, oNom As IXMLDOMElement)
Dim XInfos As IXMLDOMNode
Set XInfos = objDOM.createElement(strElem)
XInfos.Text = Data
oNom.appendChild XInfos
End Sub








Sub ConvertToTXT()
Dim MyStr As String, PageName As String, FirstRow As Integer, LastRow As Integer, MyRow As Integer

PageName = "C:\Users\Tex'Ance\Desktop\20Juil\TextFileFW" & Format(Time, "HHMM") & ".txt" ' location and Name of saved file


Open PageName For Output As #1
Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " " & "encoding=" & Chr(34) & "utf - 8" & Chr(34) & " " & "?>"
Print #1, " " & "<Markers>"
For MyRow = 2 To 20 ' loop through each row of the table
MyStr = ""
MyStr = " " & "<marker Lat= " & Chr(34) & Cells(MyRow, 1).Value & Chr(34) & " " & "Lng=" & Chr(34) & _
Cells(MyRow, 2).Value & Chr(34) & " " & "Address=" & Chr(34) & Cells(MyRow, 3).Value & Chr(34) & " " & _
"Postcode= " & Chr(34) & Cells(MyRow, 4).Value & Chr(34) & " " & "Name=" & Chr(34) & Cells(MyRow, 5).Value & _
Chr(34) & " " & "Category=" & Chr(34) & Cells(MyRow, 6).Value & Chr(34) & "/>"

Print #1, MyStr
Next
Print #1, " " & "</Markers>"
Close #1
ActiveSheet.Range("G2").ClearContents ' note that this row expects the worksheet to be named DATA
ActiveSheet.Hyperlinks.Add Range("G2"), PageName
End Sub

=============
'Dans le meme ordre d'idee, j'ai essaye un autre code qui fonctionne bien chez moi (mais de nouveau pas au travail), mais ou le fichier est plus general et directement converti en xml:
Mayzz
Messages postés
2813
Date d'inscription
mardi 15 avril 2003
Statut
Membre
Dernière intervention
2 juin 2020
 32
25 juil. 2010 à 16:38
disashy > Tu n'es pas au bon endroit pour poser tes questions, il y a le forum pour cela.
christian_grandjean
Messages postés
25
Date d'inscription
dimanche 7 novembre 2004
Statut
Membre
Dernière intervention
19 novembre 2013
 2
24 juil. 2010 à 08:00
Bonjour,
Je ne vois rien qui saute aux yeux dans votre code, une seule chose me dérange c'est le chemin utilisé File = "C:\Users\Tex'Ance\Desktop\test2.xml" il y a un ' apostrophe dans le chemin je ne sais pas si c'est désiré.
Salutations
http://www.simple-tech.info
disashy
Messages postés
3
Date d'inscription
lundi 8 février 2010
Statut
Membre
Dernière intervention
29 juillet 2010
14 juil. 2010 à 20:26
Mon code est le suivant:

Option Explicit
Option Base 1

Sub XMLmarkers()
Dim xmlDoc As MSXML2.DOMDocument
Dim xmLstring As String, File As String, strQuote As String
Dim Row As Integer, Col As Integer
Dim Attribut As Variant


strQuote = """"
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmLstring = "<?xml version=""1.0"" encoding=""utf-8"" ?> "
xmLstring = xmLstring & "<Markers TitleName=" & strQuote _
& "markers" & strQuote & "> "

Attribut = Array("Lat", "Lng", "Postcode", "Address", "Name", "Category", "Description")


For Row = 2 To Sheets("Sheet1").UsedRange.Rows.Count
xmLstring = xmLstring & "<marker "
For Col = 1 To 7
xmLstring = xmLstring & Attribut(Col) & "=" & _
strQuote & Cells(Row, Col) & strQuote & " "
Next
xmLstring = xmLstring & " />"
xmLstring = xmLstring & " "

Next Row

xmLstring = xmLstring & "</Markers>"

xmlDoc.loadXML xmLstring
File = "C:\Users\Tex'Ance\Desktop\test2.xml"
xmlDoc.Save (File)
End Sub
disashy
Messages postés
3
Date d'inscription
lundi 8 février 2010
Statut
Membre
Dernière intervention
29 juillet 2010
14 juil. 2010 à 20:25
bonjour, j'ai le code suivant pour creer un fichier xml depuis excel 2003.Chez mioi, le fichier xml est parfiait, mais au travail (intranet), le fichier xml cree est vide.
Aidez-moi, svp.
Disa
Afficher les 7 commentaires
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (christian_grandjean)