VBA macro to write and read an xml file

Hello

I want to be able to create an xml file from solidworks and also read it and retrieve values from this file.

The goal is to be able to save different CheckBox options depending on the computer from which the macro is launched, and retrieve them at the next launch with possible modification.

I found a functional method to write this xml file but impossible to retrieve values (it inserts me as a space between each letter in the macro viewport and yet the xml is without space between the letters.

Here is the xml file:

<OPTIONS>
    <CheckBoxCacherPièce="Vrai">
    <CheckBoxCacherPlan="Vrai">
    <CheckBoxDesignation="Vrai">
    <CheckBoxCouleur="Vrai">
    <CheckBoxRevision="Vrai">
</OPTIONS>

The macro to write:

'   Add a reference to Microsoft Scripting Runtime (click Tools > References > Browse > C:\windows\system32\scrrun.dll.

Sub ecrire()
    'Exemple XML attribute:   <Counter name="Incrementing0" Version="1" id="Incrementing0" Auto="0" AutoName="" type="1" RangeCounter="False" RangeDate="23/12/2019">

    Dim swApp As SldWorks.SldWorks
    Dim sPath As String
    Dim sPathName As String
    Dim fso As Scripting.FileSystemObject
    Dim XMLfile As Scripting.TextStream

    Set swApp = Application.SldWorks
    sPath = Environ("USERPROFILE") & "\.SaveMacroSldworks\"
    sPathName = sPath & "SaveMacroIndice.xml"
    Debug.Print sPathName
    
    'On vérifie si le dossier existe sinon on le créé
    'If Dir(sPath) = "" Then
    If Dir(sPath, vbDirectory + vbHidden) = "" Then
    Debug.Print "Création du dossier: " & sPath
    MkDir sPath
    End If


    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set XMLfile = fso.CreateTextFile(sPathName, True, True)

    XMLfile.WriteLine "<OPTIONS>"
            'On vérifie tout les objets commençant par CheckBox et on sauvegarde la valeur de l'option dans le fichier xml
            Dim ole1 As Control
            For Each ole1 In UserformOptionsMacro.Controls
            If Left$(ole1.Name, 8) = "CheckBox" Then XMLfile.WriteLine "    <" & ole1.Name & "=" & Chr(34) & ole1.Value & Chr(34) & ">"
            Next
            'XMLfile.WriteLine "    <Option 1=" & Chr(34) & True & Chr(34) & ">"

    XMLfile.WriteLine "</OPTIONS>"
    
    XMLfile.Close
    


End Sub

The macro to read:

Sub lire()

    Dim swApp As SldWorks.SldWorks
    Dim sPath As String
    Dim sPathName As String
    Dim fso As Scripting.FileSystemObject
    Dim XMLfile As Scripting.TextStream
    Dim stChaine As String

    Set swApp = Application.SldWorks

    sPath = Environ("USERPROFILE") & "\.SaveMacroSldworks\"
    sPathName = sPath & "SaveMacroIndice.xml"
    Debug.Print sPathName

    
    Set fso = CreateObject("Scripting.FileSystemObject")
    'Ajouter la gestion d'erreur si fichier introuvable
    Set XMLfile = fso.OpenTextFile(sPathName, ForReading, True, TristateFalse)
    
    'Read till the end
    Do Until XMLfile.AtEndOfStream
     'Debug.Print "Printing line " & XMLfile.Line
     'Debug.Print XMLfile.ReadLine 'Print a line from the file
     stChaine = XMLfile.ReadLine
     stChaine = Replace(stChaine, " ", vbNullString)
     Debug.Print stChaine
     If stChaine Like "*Checkbox*" Then MsgBox "CheckBox ok"

Loop
XMLfile.Close


End Sub

If someone has another more functional method, an example or simply a lead to communicate to me, it will allow me to move forward with my project.

 

Thank you in advance.

Hello

Look here: https://arkham46.developpez.com/articles/office/officeweb/?page=page_4

Have a good day and good code.

1 Like

Thank you remrem  for the track, I already had an equivalent, the problem is that the example data comes from Excel macro, which I can't transpose into a SW macro.

Ideally I would need a simple example under SW.

I'm going to dig deeper into it, and hopefully I'll have more inspiration than last week!

Hello
What's your problem?

1 Like

Remrem , my problem came from the declaration for Excel in solidworks.

It seems that I'm on the right track, I managed to create an xml file thanks to this code adapted from your example:

    Option Explicit

     
' Add MS excel as reference (Outil\Référence)
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBooks As Excel.Workbooks
 
    Sub Main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlSheet = xlApp.ActiveSheet
   
    'on lance la fonction ecrire le fichier xml
    CreateXMLFileVBA

    
        'clean up
    xlApp.Visible = True
    'PostMessage xlApp.hwnd, WM_QUIT, 0, 0
    
    Set xlBooks = Nothing
    Set xlApp = Nothing
    End Sub

   
Function CreateXMLFileVBA()
Debug.Print "function createXMLFIile"
Dim fic As Integer
fic = FreeFile
Open "C:\Temp\XMLFileVBA.xml" For Output As #fic
Print #fic, "<?xml version=""1.0"" encoding=""ISO-8859-1""?>"
Print #fic, "<racine>"
Print #fic, "    <info1>test élément 1</info1>"
Print #fic, "    <info2>test élément 2</info1>"
Print #fic, "    <info>"
Print #fic, "        <subinfo1>test sous-élément 1</subinfo1>"""
Print #fic, "        <subinfo2>test sous-élément 2</subinfo2>"
Print #fic, "    </info>"
Print #fic, "</racine>"
Close #fic
End Function

All I have to do is adapt the code to read and make it cleaner as soon as I have a little moment.

By the way, if you have any remarks to make the code cleaner, don't hesitate, I'm interested!

Still me, after trying impossible with the Dom method to write or retrieve an xml file, to write I have the other method perfectly functional but impossible to recover the information.

Here is the code the problem is surely in the declaration or reference then what this line is in error: Dim oXML As MSXML2. DOMDocument (in the function) and yet I did add Microsoft Excel 16.0 and Microsoft XML, v6.0 in the references

Any idea where my mistake could come from?

    Option Explicit

     
' Add MS excel as reference (Outil\Référence)
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBooks As Excel.Workbooks
 
    Sub Main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    Set xlSheet = xlApp.ActiveSheet
   
    'on lance la fonction ecrire le fichier xml
    'CreateXMLFileVBA
    'on lance la fonction lire le fichier xml
    ReadXMLFileXML
    
        'clean up
    xlApp.Visible = True
    'PostMessage xlApp.hwnd, WM_QUIT, 0, 0
    
    Set xlBooks = Nothing
    Set xlApp = Nothing


    End Sub

   
Function CreateXMLFileVBA()
Debug.Print "function createXMLFIile"
Dim fic As Integer
fic = FreeFile
Open "C:\Temp\XMLFileVBA.xml" For Output As #fic
Print #fic, "<?xml version=""1.0"" encoding=""ISO-8859-1""?>"
Print #fic, "<racine>"
Print #fic, "    <info1>test élément 1</info1>"
Print #fic, "    <info2>test élément 2</info1>"
Print #fic, "    <info>"
Print #fic, "        <subinfo1>test sous-élément 1</subinfo1>"""
Print #fic, "        <subinfo2>test sous-élément 2</subinfo2>"
Print #fic, "    </info>"
Print #fic, "</racine>"
Close #fic
End Function


Function ReadXMLFileXML()
Debug.Print "ReadXMLFileXML"
Dim oXML As MSXML2.DOMDocument
Set xlApp = CreateObject("MSXML2.DOMDocument")
Dim oNode As MSXML2.IXMLDOMNode



'Set oXML = New MSXML2.DOMDocument
'oXML.async = False
'oXML.Load "C:\XMLFileVBA.xml"
'For Each oNode In oXML.documentElement.childNodes
   'Debug.Print oNode.baseName
'Next

xlApp.async = False
xlApp.Load "C:\Temp\XMLFileVBA.xml"
For Each oNode In xlApp.documentElement.childNodes
   Debug.Print oNode.baseName
Next
           

End Function
    Option Explicit

     
' Add MS excel as reference (Outil\Référence)
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBooks As Excel.Workbooks
 
    Sub Main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    Set xlSheet = xlApp.ActiveSheet
   
    'on lance la fonction ecrire le fichier xml
    'CreateXMLFileVBA
    'on lance la fonction lire le fichier xml
    ReadXMLFileXML
    
        'clean up
    xlApp.Visible = True
    'PostMessage xlApp.hwnd, WM_QUIT, 0, 0
    
    Set xlBooks = Nothing
    Set xlApp = Nothing


    End Sub

   
Function CreateXMLFileVBA()
Debug.Print "function createXMLFIile"
Dim fic As Integer
fic = FreeFile
Open "C:\Temp\XMLFileVBA.xml" For Output As #fic
Print #fic, "<?xml version=""1.0"" encoding=""ISO-8859-1""?>"
Print #fic, "<racine>"
Print #fic, "    <info1>test élément 1</info1>"
Print #fic, "    <info2>test élément 2</info1>"
Print #fic, "    <info>"
Print #fic, "        <subinfo1>test sous-élément 1</subinfo1>"""
Print #fic, "        <subinfo2>test sous-élément 2</subinfo2>"
Print #fic, "    </info>"
Print #fic, "</racine>"
Close #fic
End Function


Function ReadXMLFileXML()
Debug.Print "ReadXMLFileXML"
Dim oXML As MSXML2.DOMDocument
Set xlApp = CreateObject("MSXML2.DOMDocument")
Dim oNode As MSXML2.IXMLDOMNode



'Set oXML = New MSXML2.DOMDocument
'oXML.async = False
'oXML.Load "C:\XMLFileVBA.xml"
'For Each oNode In oXML.documentElement.childNodes
   'Debug.Print oNode.baseName
'Next

xlApp.async = False
xlApp.Load "C:\Temp\XMLFileVBA.xml"
For Each oNode In xlApp.documentElement.childNodes
   Debug.Print oNode.baseName
Next
           

End Function

Hello

Try with the attached example macro.

Kind regards


macroxml.swp
1 Like

Thank you d.roger I had just managed to make a functional code thanks to this site: https://analystcave.com/vba-xml-working-xml-files/

After try your code works perfectly and will surely help me finalize mine, or even replace it for the most part.

All I have to do is roll up my sleeves!

 

Thank you also remrem your link helped me a lot too, it's thanks to some information from this link that I was able to end up on mine with a more recent and successful code and therefore more functional.