Attribut hinzufügen

Sub writeCalendar()
   Dim xDoc As MSXML2.DOMDocument
   Dim node As MSXML2.IXMLDOMNode
   Dim sPathXML$, r&, sXMLString$
   Dim Isin As String
   Dim Lastrow As Long
   Dim Row As Long
   Dim Zelle As Object
   Dim xSheet As Worksheet
   Dim Monat As String
   Dim Tag As String
   Dim child As IXMLDOMNode
   Dim newNode As MSXML2.IXMLDOMNode
   Dim objAttr As MSXML2.IXMLDOMAttribute
   Dim AttrColl As MSXML2.IXMLDOMNamedNodeMap
      
    Set xSheet = ThisWorkbook.Worksheets("Calendar")
    
   Isin = ThisWorkbook.Worksheets("Prozessbeschreibung").Range("J6").Value
   sPathXML = "C:\Users\marcw\Desktop\Ftc XML - Stand 01.01.2023\" & Isin & ".xml"
   sXMLString = LeseXMLFile(sPathXML)
   Set xDoc = New MSXML2.DOMDocument
   xDoc.validateOnParse = False
   
   If xDoc.LoadXML(sXMLString) Then
   
    Lastrow = xSheet.Cells(Rows.Count, 1).End(xlUp).Row
    For Row = 2 To Lastrow
    
    Set Zelle = xSheet.Cells(Row, 1)
    
    ' FiscalYearEnd einfügen
        
    If Zelle.Value = "endfiscalyear" Then
    
      With xDoc
      Set node = .SelectSingleNode("//" & xSheet.Cells(Row, 3).Value)
      Monat = Right(xSheet.Cells(Row, 2), 3)
       If InStr(1, Monat, ".") > 0 Then Monat = Replace(Monat, ".", "")
        node.Attributes.Item(0).NodeValue = Monat
        
        Tag = Left(xSheet.Cells(Row, 2), 2)
         If InStr(1, Tag, ".") > 0 Then Tag = Replace(Tag, ".", "")
         node.Attributes.Item(1).NodeValue = Tag
         End With
         GoTo Sprung
         
       Else
       End If
       If xSheet.Cells(Row, 4).Value = "ignore" Then
       
       GoTo Sprung
       
       Else
       
' ------------------------------     Hier beginnt der relevante Teil -----------------------------------------------
       
       Set node = xDoc.SelectSingleNode("//" & xSheet.Cells(Row, 3).Value)
       Set node = node.ParentNode
       Set node = node.ParentNode
       Set node = node.ParentNode
       End If
       
       If node.BaseName = "calendar" Then
   
          
        Set child = xDoc.createElement("year")
         Set newNode = node.appendChild(child)
         
               
        Set objAttr = xDoc.createAttribute("yr")      ' Attribut erstellen
        objAttr.NodeValue = Right(xSheet.Cells(Row, 1).Value, 4)
        
                      
        Set AttrColl = child.Attributes
' --------------------Bis hier hin hat alles geklappt und dann kommt nach der nächsten Zeile der Fehler. ---------------------
        
        AttrColl.setNamedItem (objAttr)
      
         Else
        End If