|  
                                             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. 
     |