Search code examples
excelxmlvbaxsdnamed-ranges

Create XML file from named cells and their values

I want to create an XML file from the named cells and their values in a macro,

the final objective is to loop on the named cells, extract information from the names to create nodes and their values to create other nodes by following a very precise structure

as a beginner on VBA Excel I tried these pieces of code just to create as many nodes as cell names on a sheet but it doesn't work

    Sub test2xml()

Dim Doc_XML As Object   'Va nous permettre de créer le XML
Dim Root As Object      '... de créer la racine du XML
Dim Node As Object      '... de créer les noeuds
Dim Name As Object      '... de créer les attributs
Dim Chemin As String    'Chemin de sauvegarde

Set Doc_XML = CreateObject("MSXML2.DOMDocument")    'Création du XML

'Ajout des données d'encodage/etc...
Set Node = Doc_XML.createProcessingInstruction("xml", "version=""1.0"" encoding=""utf-8""")

Doc_XML.appendChild Node                            'Ajout des données au fichier
Set Node = Nothing                                  'Remise à zéro du noeud
Set Root = Doc_XML.createElement("Root")            'Création d'une racine
Doc_XML.appendChild Root                            'Ajout de la racine au XML


Set Node = Doc_XML.createElement("Child55")             'Création d'un noeud
Root.appendChild Node                               'Ajout du noeud à la racine
Node.Text = "Text 1"                                'Ajout d'un texte dans le noeud

Set Node = Nothing


Dim Plage As Range
Dim Nm As Name

On Error Resume Next
'Boucle sur les noms du classeur
For Each Nm In ThisWorkbook.Names
    Set Plage = Nm.RefersToRange

    If Not Plage Is Nothing Then
        'Vérifie si le nom appartient à la feuille
        If Worksheets("T06").Name = Plage.Worksheet.Name Then _
            Node = Doc_XML.createElement("ValeurCellule")         'Création d'un noeud
            Root.appendChild Node                          'Ajout du noeud à la racine
            Node.Text = Nm.Name
            Set Node = Nothing
    End If

    Set Plage = Nothing
Next Nm


'Sauvegarde
Chemin = ThisWorkbook.Path & "\Nom du Fichier.xml"  'Chemin de sauvegarde + Nom du fichier
Doc_XML.Save Chemin

End Sub

the XML file is created but only the first static node is created, other dynamics are not created

thank you in advance

Solution

  • XML creation

    MS Help to RefersToRange states as follows

    If the Name object doesn't refer to a range (for example, if it refers to a constant or a formula), this property fails.

    I suppose these cases wouldn't occur in your xml structure, so you have to do some error handling.

    The actual issue, however, is not the RefersToRange property, but the simple fact, that you have to Set objects, e.g.

        Set Node = Doc_XML.createElement(Nm.Name)

    Furthermore I assume you want to display

    • the cell's name as node name (e.g. <Name1>..</Name1>, and not each time <ValeurCellule>...</ValeurCellule>
    • the node content to be filled by the referring cell's content, and not by the cell name

    ...(if not that can be changed easily back similar to your OP's code using repetitive <ValeurCellule>...</ValeurCellule> nodes with the names as node contents)

    Additional hint: I recommend to declare current and latest version 6 (without version number the declaration defaults to vers. 3!), i.e. 

     Set Doc_XML = CreateObject("MSXML2.DOMDocument.6.0")

    Code example close to your post

    Public Sub test2xml()

Dim Doc_XML As Object   'Va nous permettre de créer le XML
Dim Root    As Object   '... de créer la racine du XML
Dim Node    As Object   '... de créer les noeuds
Dim Name    As Object   '... de créer les attributs
Dim Chemin  As String   'xml file path
''Stop
Set Doc_XML = CreateObject("MSXML2.DOMDocument.6.0")    'Création du XML <<version 6.0>>

'Ajout des données d'encodage/etc...
Set Node = Doc_XML.createProcessingInstruction("xml", "version=""1.0"" encoding=""utf-8""")

Doc_XML.appendChild Node                            'Ajout des données au fichier
'Set Node = Nothing                                  'Remise à zéro du noeud
Set Root = Doc_XML.createElement("Root")            'Création d'une racine
Doc_XML.appendChild Root                            'Ajout de la racine au XML

Set Node = Doc_XML.createElement("Child55")         'Création d'un noeud
Root.appendChild Node                               'Ajout du noeud à la racine
Node.Text = "Text 1"                                'Ajout d'un texte dans le noeud

Dim Plage As Range
Dim Nm As Name
'Loop through workbook names
For Each Nm In ThisWorkbook.Names

    On Error Resume Next
    Set Plage = Nm.RefersToRange
    ' Error handling immediately after the risky property
    If Err.Number = 0 Then
        Debug.Print Nm & " refers to ~> " & Plage.Value     ' display only for testing, omit name + value
    Else
        Debug.Print Nm & " Error No " & Err.Number & "**refers to constant or formula: " & Evaluate(Nm.RefersTo)
    End If

    If Not Plage Is Nothing Then
        'check if correct worksheet name, then >>Set<< Node
        If Worksheets("T06").Name = Plage.Worksheet.Name Then _
            Set Node = Doc_XML.createElement(Nm.Name)      '<~~ Création d'un noeud with the ~> Cell's Name
            Root.appendChild Node                          'Ajout du noeud à la racine
            Node.Text = Plage.Value                        'cell content
    End If
    Set Plage = Nothing
Next Nm

'Save xml file
Chemin = ThisWorkbook.Path & "\xml\Nom du Fichier.xml"  'Chemin de sauvegarde + Nom du fichier
Doc_XML.Save Chemin                                     'save xml file

'Debug.Print Doc_XML.XML                                ' optional display in immediate window
End Sub