Public Function OpenXML(ByRef strSource As String, Optional oType As OpenXMLDoc = oxFile) As Boolean
Public Function ReadNode(strQuery As String, Optional strDefault As String = "" As String
Public Function ReadNodeByIndex(strQuery As String, lngIndex As Long, Optional strDefault As String = "" As String
Public Function ReadNodeXML(strQuery As String) As String
Public Function ReadNodeXMLByIndex(strQuery As String, lngIndex As Long) As String
Public Property Get XML() As String
Public Function Save(strFileName As String)
Public Function ReadAttribute(strQuery As String, strName As String, Optional strDefault As String = "" As String
Public Function ReadAttributeByIndex(strQuery As String, strName As String, lngIndex As Long, Optional strDefault As String = "" As String
Public Function NodeCount(strQuery As String) As Long
Public Function DeleteNode(strQuery As String)
Public Function WriteNode(strQuery As String, Value As Variant)
Public Function WriteAttribute(strQuery As String, strName As String, Value As Variant)
Public Function WriteAttributeByIndex(strQuery As String, strName As String, Value As Variant, lngIndex As Long)

'Автор: akartanis@akguild.com, zagzag@xaker.ru
Option Explicit

Dim xDoc As MSXML.DOMDocument

Public Enum OpenXMLDoc
    oxFile = 0
    oxString = 1
End Enum

Public Function OpenXML(ByRef strSource As String, Optional oType As OpenXMLDoc = oxFile) As Boolean
    Set xDoc = New MSXML.DOMDocument
    
    Select Case oType
        Case oxFile
            OpenXML = xDoc.Load(strSource)
        Case oxString
            OpenXML = xDoc.loadXML(strSource)
    End Select
End Function

Public Function ReadNode(strQuery As String, Optional strDefault As String = "" As String
On Error GoTo ErrHandle:
Dim xNode As MSXML.IXMLDOMNode

    Set xNode = xDoc.documentElement.selectSingleNode(strQuery)
    ReadNode = xNode.Text
    Set xNode = Nothing
    
    Exit Function
ErrHandle:
    ReadNode = Null
    Set xNode = Nothing
End Function

Public Function ReadNodeByIndex(strQuery As String, lngIndex As Long, Optional strDefault As String = "" As String
On Error GoTo ErrHandle:
Dim xNode As MSXML.IXMLDOMNode

    Set xNode = xDoc.documentElement.selectNodes(strQuery).Item(lngIndex)
    If xNode Is Nothing Then
        ReadNodeByIndex = ""
    Else
        ReadNodeByIndex = xNode.Text
    End If
    Set xNode = Nothing
    
    Exit Function
ErrHandle:
    ReadNodeByIndex = Null
    Set xNode = Nothing
End Function

Public Function ReadNodeXML(strQuery As String) As String
Dim xNode As MSXML.IXMLDOMNode
Set xNode = xDoc.documentElement.selectSingleNode(strQuery)
    MsgBox xNode.childNodes
    ReadNodeXML = xNode.XML
    Set xNode = Nothing
End Function

Public Function ReadNodeXMLByIndex(strQuery As String, lngIndex As Long) As String
On Error GoTo ErrHandle:
Dim xNode As MSXML.IXMLDOMNode

    Set xNode = xDoc.documentElement.selectNodes(strQuery).Item(lngIndex)
    If xNode Is Nothing Then
        ReadNodeXMLByIndex = ""
    Else
        ReadNodeXMLByIndex = xNode.XML
    End If
    Set xNode = Nothing
    
    Exit Function
ErrHandle:
    ReadNodeXMLByIndex = Null
    Set xNode = Nothing
End Function

Public Property Get XML() As String
    XML = xDoc.XML
End Property

Public Function Save(strFileName As String)
    xDoc.Save strFileName
End Function

Public Function ReadAttribute(strQuery As String, strName As String, Optional strDefault As String = "" As String
On Error GoTo ErrHandle:
Dim xNode As MSXML.IXMLDOMElement

    Set xNode = xDoc.documentElement.selectSingleNode(strQuery)
    ReadAttribute = xNode.getAttribute(strName)
    Set xNode = Nothing
    
    Exit Function
ErrHandle:
    ReadAttribute = strDefault
    Set xNode = Nothing
End Function

Public Function ReadAttributeByIndex(strQuery As String, strName As String, lngIndex As Long, Optional strDefault As String = "" As String
On Error GoTo ErrHandle:
Dim xNode As MSXML.IXMLDOMElement

    Set xNode = xDoc.documentElement.selectNodes(strQuery).Item(lngIndex)
    ReadAttributeByIndex = xNode.getAttribute(strName)
    Set xNode = Nothing
    
    Exit Function
ErrHandle:
    ReadAttributeByIndex = strDefault
    Set xNode = Nothing
End Function

Public Function NodeCount(strQuery As String) As Long
On Error GoTo ErrHandle:
Dim xNode As MSXML.IXMLDOMNodeList

    Set xNode = xDoc.documentElement.selectNodes(strQuery)
    NodeCount = xNode.length
    Set xNode = Nothing
    
    Exit Function
ErrHandle:
    NodeCount = -1
    Set xNode = Nothing
End Function

Public Function DeleteNode(strQuery As String)
On Error GoTo ErrHandle:
Dim xNode As MSXML.IXMLDOMNode
    Set xNode = xDoc.documentElement.selectSingleNode(strQuery)
    xNode.parentNode.removeChild xNode
    Set xNode = Nothing
    Exit Function
ErrHandle:
    Set xNode = Nothing
End Function

Public Function WriteNode(strQuery As String, Value As Variant)
On Error GoTo ErrHandle:
Dim xNode As MSXML.IXMLDOMNode
    Set xNode = xDoc.documentElement.selectSingleNode(strQuery)
    xNode.Text = Value
    Set xNode = Nothing
    Exit Function
ErrHandle:
    Set xNode = Nothing
End Function

Public Function WriteAttribute(strQuery As String, strName As String, Value As Variant)
On Error GoTo ErrHandle:
Dim xNode As MSXML.IXMLDOMElement
    Set xNode = xDoc.documentElement.selectSingleNode(strQuery)
    xNode.setAttribute strName, Value
    Set xNode = Nothing
    Exit Function
ErrHandle:
    Set xNode = Nothing
End Function

Public Function WriteAttributeByIndex(strQuery As String, strName As String, Value As Variant, lngIndex As Long)
On Error GoTo ErrHandle:
Dim xNode As MSXML.IXMLDOMElement
    Set xNode = xDoc.documentElement.selectNodes(strQuery).Item(lngIndex)
    xNode.setAttribute strName, Value
    Set xNode = Nothing
    Exit Function
ErrHandle:
    Set xNode = Nothing
End Function

Там XML очень большой, быстрее будет парсить его ручками,
формируя таблицу ссылок для постов.