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
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)
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
xmlDoc.Async = False
xmlDoc.ValidateOnParse = False
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
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
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
If colIndex = 6 Then
ParseAndWriteFirstFile xmlDoc.DocumentElement, currentRow
Else
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
Sheets(3).Cells(foundRow.Row, colIndex).Value = node.text
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
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