Option Explicit
Option Compare Text

''' Для примера страница сайта с которой есть проблема XML
Private Const strURL As String = "https://auction.openprocurement.org/tenders/2889f213faf9415ba9d27e97fd675cd9"

Sub NotWorkingParser_XML()
Dim objHTMLDoc As HTMLDocument
''' объект objHTMLDoc As HTMLDocument, объявлен ранним связыванием
''' Tools -> References -> Microsoft HTML Object Library. > C:\Windows\SysWOW64\mshtml.tlb
Dim objXML As Object, Tag1, vl1
Dim strOtvetAukcion As String, strTrimer As String

Set objHTMLDoc = New HTMLDocument
Set objXML = CreateObject("MSXML2.XMLHTTP.6.0")
''' Формирование заголовка запроса
objXML.Open "GET", strURL, False
objXML.setRequestHeader "Accept", "*/*"
objXML.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:49.0) Gecko/20100101 Firefox/58.0.1"
objXML.setRequestHeader "Proxy-Connection", "Keep-Alive"
objXML.setRequestHeader "Cache-Control", "no-cache"
objXML.setRequestHeader "If-Modified-Since", "Thu, 1 Jan 1970 00:00:00 UTC"
objXML.setRequestHeader "Content-Type", "text/xml"
'''Чтобы браузер распарсил ответ сервера в свойство responseXML, _
   в ответе должен быть заголовок Content-Type: text/xml. Иначе свойство responseXML будет равно null.
'''objXML.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objXML.sEnd
''' Получить ответ
While objXML.readyState <> 4: DoEvents: Wend
objHTMLDoc.body.innerHTML = objXML.responseText

''' ===========================================
''' В процессе реализации получить ответ использовались различные методы
''' getElementById, getElementsByClassName, getElementsByTagName
''' setRequestHeader "Content-Type", "text/xml", "application/x-www-form-urlencoded", "text/html"
''' objHTMLDoc.body.innerHTML = ConvertBytesToString(objXML.responseBody)
''' ничего не помогло (:
''' ===========================================

''' статус аукциона
Set Tag1 = objHTMLDoc.getElementsByClassName("header-auction-item navbar-brand pull-left round-info timer-text")
Debug.Print Trim$(Tag1.Item(0).innerText) & vbNewLine
''' набор данных шаги аукциона
For Each Tag1 In objHTMLDoc.getElementsByClassName("auction-round")
  For Each vl1 In Tag1.Children
    strTrimer = Trim$(Application.WorksheetFunction.Clean(vl1.innerText))
    strOtvetAukcion = strOtvetAukcion & strTrimer & vbNewLine
  Next
  Debug.Print strOtvetAukcion & vbNewLine
  strOtvetAukcion = vbNullString
Next
Set objHTMLDoc = Nothing
Set objXML = Nothing
End Sub
      
Sub NotWorkingParser_IE()
''' Минусы работы с InternetExplorer
''' 1. Проблемы возникают при наличии в отделе нескольких компов с разными версиями Windows, IE
''' 2. Скорость выполнения парсинга сайтов. По сравнению с XML иногда достигает разницы в десятки раз.
Dim objIE As Object
Dim strOtvetAukcion As String, strTrimer As String
Dim Tag1, vl1
    Set objIE = CreateObject("InternetExplorer.Application"):
    objIE.navigate strURL
    DoEvents
    While objIE.busy Or (objIE.readyState <> 4): DoEvents: Wend
'    Do While objIE.busy Or (objIE.readyState <> 4)
'      DoEvents: Application.Wait (Now + TimeValue("0:00:02"))
'    Loop
    ''' статус аукциона
    Set Tag1 = objIE.document.getElementsByClassName("header-auction-item navbar-brand pull-left round-info timer-text")
    Debug.Print Trim$(Tag1.Item(0).innerText)
    ''' набор данных шаги аукциона
    For Each Tag1 In objIE.document.getElementsByClassName("auction-round")
      For Each vl1 In Tag1.Children
        strTrimer = Trim$(Application.WorksheetFunction.Clean(vl1.innerText))
        strOtvetAukcion = strOtvetAukcion & strTrimer & vbNewLine
      Next
      ''' ответ веб-страницы
      Debug.Print strOtvetAukcion
      strOtvetAukcion = vbNullString
    Next
objIE.Quit: Set objIE = Nothing
End Sub
        
Private Function ConvertBytesToString(ArrByte)
Dim ADOStream
Set ADOStream = CreateObject("ADODB.Stream")
  With ADOStream
    .Type = 1 'adTypeBinary
    .Open:  .Write ArrByte: .Position = 0
    .Type = 2 'adTypeText
    .Charset = "windows-1251"
     ConvertBytesToString = .ReadText
    .Close
  End With
Set ADOStream = Nothing
End Function