Private Const strFilePath As String = "D:\2\Test.xml"

Public Sub CreateXML()
    ' Для работы подключи библиотеку
    ' "Microsoft XML".
    
    Dim objDoc As MSXML2.DOMDocument
    Dim objNode As MSXML2.IXMLDOMNode
    Dim objRoot As MSXML2.IXMLDOMElement
    Dim objCar As MSXML2.IXMLDOMElement
    
    Set objDoc = New DOMDocument
    objDoc.resolveExternals = True
    
    Set objNode = objDoc.createProcessingInstruction( _
      "xml", "version='1.0' encoding='UTF-8'")
    Set objNode = objDoc.insertBefore(objNode, _
      objDoc.childNodes.Item( 0 ))
    
    Set objRoot = objDoc.createElement("dataroot")
    Set objDoc.documentElement = objRoot
    objRoot.setAttribute "xmlns:od", _
      "urn:schemas-microsoft-com:officedata"
    
    Set objCar = objDoc.createElement("Car")
    objRoot.appendChild objCar
    
    Set objNode = objDoc.createElement("Make")
    objNode.Text = "Mini Cooper"
    objCar.appendChild objNode
    
    Set objNode = objDoc.createElement("Model")
    objNode.Text = "S"
    objCar.appendChild objNode

    Set objNode = objDoc.createElement("Price")
    objNode.Text = "20,000"
    objCar.appendChild objNode
    
    objDoc.Save strFilePath
End Sub