Thema Datum  Von Nutzer Rating
Antwort
03.02.2025 13:12:07 Gast98551
NotSolved
03.02.2025 19:04:25 Gast75772
NotSolved
03.02.2025 20:39:14 volti
NotSolved
04.02.2025 12:30:20 Gast19586
NotSolved
04.02.2025 14:08:15 Volti
NotSolved
04.02.2025 15:28:04 Gast67987
NotSolved
04.02.2025 15:58:49 Gast31143
NotSolved
04.02.2025 16:59:30 Gast39622
NotSolved
04.02.2025 18:12:20 volti
NotSolved
04.02.2025 18:25:46 volti
NotSolved
04.02.2025 19:13:41 volti
NotSolved
04.02.2025 22:38:12 Gast85035
NotSolved
04.02.2025 23:25:24 volti
NotSolved
05.02.2025 00:38:44 Gast32890
NotSolved
05.02.2025 08:42:33 volti
NotSolved
05.02.2025 08:56:36 volti
NotSolved
09.02.2025 21:57:35 Gast46537
NotSolved
05.02.2025 13:33:01 Gast89171
NotSolved
05.02.2025 15:04:45 Gast15904
NotSolved
Blau Systree - Absturz bei Zugriff auf Knoten (externes Programm)
09.02.2025 18:13:22 Gast6908
Solved

Ansicht des Beitrags:
Von:
Gast6908
Datum:
09.02.2025 18:13:22
Views:
35
Rating: Antwort:
 Nein
Thema:
Systree - Absturz bei Zugriff auf Knoten (externes Programm)

Hallo zusammen.
Kurzes Update:
Das mit dem Handlen per Windows API hat nicht geklappt. Ich werde versuchen nur die Livedaten über die Api abzugreifen. Aber das ist Zukunftsprojekt.

Ich machs jetzt über  

Sub Daten()
    Dim xmlDoc As Object
    Dim xmlNode As Object
    Dim filePath As String
    Dim currentRow As Long
    Dim cell As Range
    Dim colIndex As Integer
    Dim foundRow As Range
    Dim paramIdCol As Integer: paramIdCol = 4

    ' Bereich der Zellen festlegen, die Dateipfade enthalten
    Dim fileCells As Range
    Sheets(2).Activate
    Set fileCells = ActiveWorkbook.Sheets(2).Range("A10:Z" & ActiveWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row - 1)

    ' XML-Objekt initialisieren
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    xmlDoc.Async = False
    xmlDoc.ValidateOnParse = False

    ' Neue Tabelle vorbereiten
    Sheets(3).Cells.Clear
    With Sheets(3)
        .Cells(1, 1).Value = "ID"
        .Cells(1, 2).Value = "Beschriftung"
        .Cells(1, 3).Value = "Code"
        .Cells(1, 4).Value = "ID"
        .Cells(1, 5).Value = "Wert"
    End With

    currentRow = 2
    colIndex = 6  ' Spalte F für zweite Datei

    For Each cell In fileCells
        If cell.Value <> "" Then
            If cell.Hyperlinks.Count > 0 And cell.Hyperlinks(1).Address <> "" Then
                filePath = cell.Hyperlinks(1).Address
                If filePath <> "" And LCase(Right(filePath, 5)) = ".xcfg" Then
                    If Dir(filePath) <> "" Then
                        If xmlDoc.Load(filePath) Then
                            ' Blattüberschrift mit Dateinamen
                            Dim fileName As String
                            fileName = Mid(filePath, InStrRev(filePath, "\") + 1)
                            fileName = Replace(fileName, ".xcfg", "")
                            If Len(fileName) > 31 Then fileName = Left(fileName, 31)
                            Sheets(3).Cells(1, colIndex).Value = fileName

                            ' Daten auslesen und verarbeiten
                            If colIndex = 6 Then
                                ' Erste Datei vollständig ausgeben
                                ParseAndWriteFirstFile xmlDoc.DocumentElement, currentRow
                            Else
                                ' Weitere Dateien vergleichen und Werte eintragen
                                ParseAndCompareFiles xmlDoc.DocumentElement, colIndex, paramIdCol
                            End If
                            colIndex = colIndex + 1
                        End If
                    End If
                End If
            End If
        End If
    Next cell

    MsgBox "Analyse und Vergleich abgeschlossen!"
End Sub

Sub ParseAndWriteFirstFile(node As Object, ByRef rowNum As Long)
    Dim childNode As Object
    Dim paramCode As String
    Dim paramId As String
    Dim baseName As String

    paramCode = ""
    paramId = ""

    baseName = node.baseName
    If Not node.Attributes Is Nothing Then
        If Not node.Attributes.getNamedItem("paramCode") Is Nothing Then
            paramCode = node.Attributes.getNamedItem("paramCode").text
        End If
        If Not node.Attributes.getNamedItem("paramId") Is Nothing Then
            paramId = node.Attributes.getNamedItem("paramId").text
        End If
    End If

    If paramId <> "" Then
        With Sheets(3)
            .Cells(rowNum, 1).Value = rowNum - 1
            .Cells(rowNum, 2).Value = baseName
            .Cells(rowNum, 3).Value = paramCode
            .Cells(rowNum, 4).Value = paramId
            .Cells(rowNum, 5).Value = node.text
        End With
        rowNum = rowNum + 1
    End If

    If node.ChildNodes.Length > 0 Then
        For Each childNode In node.ChildNodes
            ParseAndWriteFirstFile childNode, rowNum
        Next childNode
    End If
End Sub

Sub ParseAndCompareFiles(node As Object, colIndex As Integer, paramIdCol As Integer)
    Dim childNode As Object
    Dim paramCode As String
    Dim paramId As String
    Dim baseName As String
    Dim foundRow As Range

    paramCode = ""
    paramId = ""

    baseName = node.baseName
    If Not node.Attributes Is Nothing Then
        If Not node.Attributes.getNamedItem("paramCode") Is Nothing Then
            paramCode = node.Attributes.getNamedItem("paramCode").text
        End If
        If Not node.Attributes.getNamedItem("paramId") Is Nothing Then
            paramId = node.Attributes.getNamedItem("paramId").text
        End If
    End If

    If paramId <> "" Then
        Set foundRow = Sheets(3).Columns(paramIdCol).Find(paramId, LookIn:=xlValues, LookAt:=xlWhole)
        If Not foundRow Is Nothing Then
            ' Wert in entsprechende Zeile eintragen
            Sheets(3).Cells(foundRow.Row, colIndex).Value = node.text
            ' Unterschied markieren
            If Sheets(3).Cells(foundRow.Row, 5).Value <> node.text Then
                Sheets(3).Cells(foundRow.Row, colIndex).Interior.Color = RGB(255, 0, 0)
            End If
        Else
            ' Neuer Eintrag, wenn paramID nicht gefunden wurde
            Dim lastRow As Long
            lastRow = Sheets(3).Cells(Rows.Count, 1).End(xlUp).Row + 1
            With Sheets(3)
                .Cells(lastRow, 1).Value = lastRow 
                .Cells(lastRow, 2).Value = baseName
                .Cells(lastRow, 3).Value = paramCode
                .Cells(lastRow, 4).Value = paramId
                .Cells(lastRow, colIndex).Value = node.text
            End With
        End If
    End If

    If node.ChildNodes.Length > 0 Then
        For Each childNode In node.ChildNodes
            ParseAndCompareFiles childNode, colIndex, paramIdCol
        Next childNode
    End If
End Sub

damit lässt sich zugreifen, mit einem weiteren script schreibe ich die änderungen in die Datei zurück. dabei gibt es noch Probleme, denn viele Werte werden nicht gefunden und nicht somit nicht übertragen und dann ist datei korrupt. ( Grund warum ich

Vielen Dank für eure Bemühungen.


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
03.02.2025 13:12:07 Gast98551
NotSolved
03.02.2025 19:04:25 Gast75772
NotSolved
03.02.2025 20:39:14 volti
NotSolved
04.02.2025 12:30:20 Gast19586
NotSolved
04.02.2025 14:08:15 Volti
NotSolved
04.02.2025 15:28:04 Gast67987
NotSolved
04.02.2025 15:58:49 Gast31143
NotSolved
04.02.2025 16:59:30 Gast39622
NotSolved
04.02.2025 18:12:20 volti
NotSolved
04.02.2025 18:25:46 volti
NotSolved
04.02.2025 19:13:41 volti
NotSolved
04.02.2025 22:38:12 Gast85035
NotSolved
04.02.2025 23:25:24 volti
NotSolved
05.02.2025 00:38:44 Gast32890
NotSolved
05.02.2025 08:42:33 volti
NotSolved
05.02.2025 08:56:36 volti
NotSolved
09.02.2025 21:57:35 Gast46537
NotSolved
05.02.2025 13:33:01 Gast89171
NotSolved
05.02.2025 15:04:45 Gast15904
NotSolved
Blau Systree - Absturz bei Zugriff auf Knoten (externes Programm)
09.02.2025 18:13:22 Gast6908
Solved