VBA-Makro zum Schreiben und Lesen einer XML-Datei

sbadenis · 26. Juni 2020 um 05:48

Hallo

Ich möchte in der Lage sein, eine XML-Datei aus SOLIDWORKS zu erstellen und sie auch zu lesen und Werte aus dieser Datei abzurufen.

Ziel ist es, je nach Computer, von dem aus das Makro gestartet wird, unterschiedliche CheckBox-Optionen zu speichern und beim nächsten Start mit möglichen Änderungen abzurufen.

Ich habe eine funktionale Methode gefunden, um diese XML-Datei zu schreiben, aber es ist unmöglich, Werte abzurufen (sie fügt mich als Leerzeichen zwischen jedem Buchstaben im Makro-Ansichtsfenster ein, und dennoch ist das XML ohne Leerzeichen zwischen den Buchstaben.

Hier ist die xml-Datei:

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

Das zu schreibende Makro:

'   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

Das zu lesende Makro:

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

Wenn jemand eine andere, funktionalere Methode, ein Beispiel oder einfach einen Lead hat, den er mir mitteilen kann, wird es mir ermöglichen, mit meinem Projekt voranzukommen.

Vielen Dank im Voraus.

remrem · 26. Juni 2020 um 07:28

Hallo

Schauen Sie hier: https://arkham46.developpez.com/articles/office/officeweb/?page=page_4

Einen schönen Tag und guten Code.

sbadenis · 29. Juni 2020 um 06:26

Danke remrem für den Track, ich hatte bereits ein Äquivalent, das Problem ist, dass die Beispieldaten aus einem Excel-Makro stammen, das ich nicht in ein SW-Makro transponieren kann.

Im Idealfall bräuchte ich ein einfaches Beispiel unter SW.

Ich werde tiefer in das Thema eintauchen und hoffentlich mehr Inspiration haben als letzte Woche!

remrem · 29. Juni 2020 um 07:53

Hallo
Was ist Ihr Problem?

sbadenis · 29. Juni 2020 um 08:10

Remrem , mein Problem kam von der Deklaration für Excel in Solidworks.

Es scheint, dass ich auf dem richtigen Weg bin, ich habe es geschafft, eine XML-Datei zu erstellen, dank dieses Codes, der von Ihrem Beispiel angepasst wurde:

    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

Alles, was ich tun muss, ist, den Code so anzupassen, dass er gelesen wird, und ihn sauberer zu machen, sobald ich einen kleinen Moment habe.

Übrigens, wenn Sie irgendwelche Anmerkungen haben, um den Code sauberer zu machen, zögern Sie nicht, ich bin interessiert!

sbadenis · 29. Juni 2020 um 14:59

Immer noch ich, nachdem ich versucht habe, mit der Dom-Methode unmöglich eine XML-Datei zu schreiben oder abzurufen, habe ich die andere Methode perfekt funktionsfähig, aber unmöglich, die Informationen wiederherzustellen.

Hier ist der Code, das Problem liegt sicherlich in der Deklaration oder Referenz, dann ist diese Zeile fehlerhaft: Dim oXML As MSXML2. DOMDocument (in der Funktion) und trotzdem habe ich Microsoft Excel 16.0 und Microsoft XML, v6.0 in den Referenzen hinzugefügt

Haben Sie eine Idee, woher mein Fehler kommen könnte?

    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

d.roger · 30. Juni 2020 um 12:10

Hallo

Versuchen Sie es mit dem beigefügten Beispielmakro.

Herzliche Grüße

macroxml.swp

sbadenis · 30. Juni 2020 um 12:13

Danke d.roger Ich hatte es gerade geschafft, dank dieser Seite einen funktionalen Code zu erstellen: https://analystcave.com/vba-xml-working-xml-files/

Nach dem Versuch funktioniert Ihr Code perfekt und wird mir sicherlich helfen, meinen fertigzustellen oder ihn sogar größtenteils zu ersetzen.

Alles, was ich tun muss, ist die Ärmel hochzukrempeln!

Vielen Dank auch an Ihren Link, der mir auch sehr geholfen hat, es ist einigen Informationen aus diesem Link zu verdanken, dass ich mit einem neueren und erfolgreicheren Code auf meinem landen konnte und daher funktionaler bin.