Public Sub RepairAttributeViolations(ByVal NodeBaseName As String, _ BadAttrBaseName As String, NewAttrBaseName As String) ' 'Fixes attribute-level schema violation problem 'when schema files are updated or replaced. ' Dim nodes As Word.XMLNodes, node As Word.XMLNode, attr As Word.XMLNode Dim newAttr As Word.XMLNode

Dim strXPath As String, strAlias As String

strAlias = "xmlns:x='" & XHTML_NAMESPACE_URI & "'"
strXPath = "//x:" & NodeBaseName

Set nodes = ActiveDocument.SelectNodes(strXPath, strAlias)

For Each node In nodes
    For Each attr In node.Attributes
        Select Case attr.BaseName
            Case BadAttrBaseName
                Set newAttr = _
                    node.Attributes.Add(NewAttrBaseName, vbNullString)
                
                newAttr.NodeValue = attr.NodeValue
                Call attr.Delete
        
        End Select
    Next
Next

End Sub

Sub tmp() ' 'Copy the correct img element attributes from oldDoc to newDoc. ' Dim oldDoc As Word.Document Dim newDoc As Word.Document

Dim oldNodes As Word.XMLNodes, newNodes As Word.XMLNodes
Dim node As Word.XMLNode, newNode As Word.XMLNode
Dim attr As Word.XMLNode, newAttr As Word.XMLNode, i As Long

Dim strXPath As String, strAlias As String

strAlias = "xmlns:x='" & XHTML_NAMESPACE_URI & "'"
strXPath = "//x:img"

Set oldDoc = Application.Documents(1)
Set newDoc = Application.Documents(2)

Set oldNodes = oldDoc.SelectNodes(strXPath, strAlias)
Set newNodes = newDoc.SelectNodes(strXPath, strAlias)

For i = 1 To oldNodes.Count
    For Each attr In oldNodes(i).Attributes
        Select Case attr.BaseName
            Case "alt"
                Set newNode = newNodes(i)
                Set newAttr = _
                    newNode.Attributes.Add("alt", vbNullString)
                newAttr.NodeValue = attr.NodeValue
        
            Case "height"
                Set newNode = newNodes(i)
                Set newAttr = _
                    newNode.Attributes.Add("height", vbNullString)
                newAttr.NodeValue = attr.NodeValue
        
            Case "src"
                Set newNode = newNodes(i)
                Set newAttr = _
                    newNode.Attributes.Add("src", vbNullString)
                newAttr.NodeValue = attr.NodeValue
        
            Case "style"
                Set newNode = newNodes(i)
                Set newAttr = _
                    newNode.Attributes.Add("style", vbNullString)
                newAttr.NodeValue = attr.NodeValue
        
            Case "width"
                Set newNode = newNodes(i)
                Set newAttr = _
                    newNode.Attributes.Add("width", vbNullString)
                newAttr.NodeValue = attr.NodeValue
        End Select
    Next
Next

End Sub

Private Sub tmp2() ' 'Delete incorrect attributes from img elements. ' Dim nodes As Word.XMLNodes, node As Word.XMLNode, attr As Word.XMLNode Dim newAttr As Word.XMLNode

Dim strXPath As String, strAlias As String

strAlias = "xmlns:x='" & XHTML_NAMESPACE_URI & "'"
strXPath = "//x:img"

Set nodes = ActiveDocument.SelectNodes(strXPath, strAlias)

For Each node In nodes
    For Each attr In node.Attributes
        Select Case attr.BaseName
            Case "shape"
                Call attr.Delete
        End Select
    Next
Next

End Sub