Private Sub CommandButton1_Click()
  Call PressButton1
End Sub

Public Sub PressButton1()
  MsgBox "Кнопка 1 нажата"
End Sub

If .cmbxOptionService.ListCount = 0 Then
      .cmbxOptionService.AddItem "Витяг з Річного плану закупівель по підрозділам"
      .cmbxOptionService.AddItem "Зміни в річний план закупівель"
      .cmbxOptionService.AddItem "Звіт по проведеним договорам"
      .cmbxOptionService.ListIndex = 0
End If

'   If .cmbxRadioOnline.ListCount = 0 Then
'      ReDim arr(1 To 5, 1 To 2)
'      arr(1, 1) = "ROKS FM"
'      arr(1, 2) = "http://online-radioroks.tavrmedia.ua/RadioROKS_HD"
'      arr(2, 1) = "Record"
'      arr(2, 2) = "http://online.radiorecord.ru:8101/rr_128"
'      arr(3, 1) = "Кисс ФМ Украина"
'      arr(3, 2) = "http://online-kissfm.tavrmedia.ua/KissFM"
'      arr(4, 1) = "Хит ФМ Украина"
'      arr(4, 2) = "http://online-hitfm.tavrmedia.ua/HitFM"
'      arr(5, 1) = "Просто Радио"
'      arr(5, 2) = "http://62.80.190.246:8000/PRK128"
'      .cmbxRadioOnline.ColumnWidths = "90;1"
'      .cmbxRadioOnline.List = arr
'      .cmbxRadioOnline.ListIndex = 0
'   End If
 len("http://online-radioroks.tavrmedia.ua/RadioROKS_HD") = 49

Option Explicit
Option Compare Text
''' объект objHTMLDoc As HTMLDocument, объявлен ранним связыванием
''' Tools -> References -> Microsoft HTML Object Library. > C:\Windows\SysWOW64\mshtml.tlb
''' Для примера страница сайта с которой берем данные
Private Const strURL As String = " https://meteoinfo.ru/forecasts/russia/vologda-area/vologda"
 
Sub Parser_meteoinfo1 ()
Dim objHTMLDoc As HTMLDocument
Dim objXML As Object, Tag1, vl1, vl2
Dim strOtvetAukcion As String, strTrimer As String
Dim arr(), i As Long, x As Long

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"
objXML.sEnd
While objXML.readyState <> 4: DoEvents: Wend
objHTMLDoc.body.innerHTML = objXML.responseText

''' набор данных
Set Tag1 = objHTMLDoc.getElementsByTagName("tr")
ReDim arr(1 To Tag1.Length, 1 To 2)
arr(1, 1) = "Осадки, день"
arr(1, 2) = "Ветер, м/с"

For Each vl1 In Tag1
  If vl1.innerHTML Like "*fc_small_gorizont_ww*" Then
    If vl1.innerHTML Like "*День*" Then
    ' извлечь данные по облачности и осадкам
      i = 1: x = 1
      For Each vl2 In vl1.Cells
        If vl2.innerText <> "День" Then
          i = i + 1
          arr(i, x) = vl2.Children.Item(0).Children.Item(0).Title
        End If
      Next
    End If
    If vl1.innerHTML Like "*Ветер, м/с*" Then
    ' извлечь направление ветра, скорость
      i = 1: x = 2
      For Each vl2 In vl1.Cells
        If vl2.innerText <> "Ветер, м/с" Then
          i = i + 1
          arr(i, x) = vl2.Children.Item(0).Children.Item(0).Title & ", " & vl2.innerText
        End If
      Next
    End If
  End If
  If x = 2 Then Exit For
Next
'' Поместить результат запроса на лист
ThisWorkbook.Sheets(1).Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr

Set objHTMLDoc = Nothing
Set objXML = Nothing
End Sub

Option Explicit
Option Compare Text
''' объект objHTMLDoc As HTMLDocument, объявлен ранним связыванием
''' Tools -> References -> Microsoft HTML Object Library. > C:\Windows\SysWOW64\mshtml.tlb

Sub Parser_meteoinfo()
Dim objHTMLDoc As HTMLDocument
Dim objXML As Object, Tag1, vl1, vl2
Dim strOtvetAukcion As String, strTrimer As String
Dim arr(), i As Long, x As Long

''' страница сайта с которой берем данные
Dim strURL As String
strURL = "https://meteoinfo.ru/forecasts/russia/vologda-area/vologda"

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"
objXML.sEnd
While objXML.readyState <> 4: DoEvents: Wend
objHTMLDoc.body.innerHTML = objXML.responseText

''' набор данных
Set Tag1 = objHTMLDoc.getElementsByTagName("tr")
ReDim arr(1 To Tag1.Length, 1 To 4)
arr(1, 1) = "Осадки, день"
arr(1, 2) = "Ветер, м/с"
arr(1, 3) = "Осадки, ночь"
arr(1, 4) = "Ветер, м/с"

For Each vl1 In Tag1
  If vl1.innerHTML Like "*fc_small_gorizont_ww*" Then
    Debug.Print vbNewLine
    Debug.Print vl1.innerHTML
    If vl1.innerHTML Like "*День*" Then
    ' извлечь данные по облачности и осадкам
      i = 1: x = 1
      For Each vl2 In vl1.Cells
        If vl2.innerText <> "День" Then
          i = i + 1
          arr(i, x) = vl2.Children.Item(0).Children.Item(0).Title
        End If
      Next
    End If
    If vl1.innerHTML Like "*Ветер, м/с*" And _
    Not vl1.innerHTML Like "*fc_small_gorizont_ww sdvig_div*" Then
    ' извлечь направление ветра, скорость
      i = 1: x = 2
      For Each vl2 In vl1.Cells
        If vl2.innerText <> "Ветер, м/с" Then
          i = i + 1
          arr(i, x) = vl2.Children.Item(0).Children.Item(0).Title & ", " & vl2.innerText
        End If
      Next
    End If
    
    If vl1.innerHTML Like "*Ночь*" Then
    ' извлечь данные по облачности и осадкам за ночь
      i = 1: x = 3
      For Each vl2 In vl1.Cells
        If vl2.innerHTML Like "*fc_small_gorizont_ww sdvig_div*" Then
          i = i + 1
          arr(i, x) = vl2.Children.Item(0).Children.Item(0).Title
        End If
      Next
    End If
    If vl1.innerHTML Like "*Ветер, м/с*" And _
       vl1.innerHTML Like "*fc_small_gorizont_ww sdvig_div*" Then
    ' извлечь направление ветра, скорость за ночь
      i = 1: x = 4
      For Each vl2 In vl1.Cells
        If vl2.innerHTML Like "*fc_small_gorizont_ww sdvig_div*" Then
          i = i + 1
          arr(i, x) = vl2.Children.Item(0).Children.Item(0).Title & ", " & vl2.innerText
        End If
      Next
    End If
  End If
  If x = 4 Then Exit For
Next
'' Поместить результат запроса на лист
ThisWorkbook.Sheets(1).Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr

Set objHTMLDoc = Nothing
Set objXML = Nothing
End Sub

Sub RemovingDuplicates()
Dim OSD As Object, arr(), oRng
Dim i As Long, sTemp As String, tmp
Dim iLastRow As Long

' Вариант 1
' Создаем словарь со списка Что удалить исключая уникальнst
Set OSD = CreateObject("Scripting.Dictionary")
    OSD.comparemode = 1
With ThisWorkbook
  With Sheets("Лист1")
    ' Загрузка в одномерный массив данных со списка "Что удалить"
    arr = .Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp)).Value
    ' Перегружаем в словарь для исключения повторений
    For i = LBound(arr) To UBound(arr)
      If Not OSD.exists(arr(i, 1)) Then OSD.Add CStr(arr(i, 1)), 0
    Next
    ' Выполняем анализ списка "Полный список", помечаем на удаление желтым фоном
    Set oRng = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
    For Each tmp In oRng
      sTemp = tmp
      If OSD.exists(sTemp) Then tmp.Interior.Color = 65535
    Next
    ' Далее можно в ручном режиме выполнить фильтр по фону и удалить ненужные строки
    ' Можно процесс полностью автоматизировать,
    ' но для этого необходимо понимать полностью цели, задачи и т.д.
  End With
End With
Erase arr
Set oRng = Nothing
Set OSD = Nothing
End Sub

Sub RemovingDuplicates()
Dim OSD As Object, arr(), oRng
Dim i As Long, sTemp As String, tmp
Dim objItog As Object

' Вариант 2
' Создаем словарь со списка Что удалить
Set OSD = CreateObject("Scripting.Dictionary")
    OSD.comparemode = 1
' Создаем словарь Ответ
Set objItog = CreateObject("Scripting.Dictionary")
    objItog.comparemode = 1
With ThisWorkbook
  With Sheets("Лист1")
    ' Загрузка в одномерный массив данных со списка "Что удалить"
    arr = .Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp)).Value
    ' Перегружаем в словарь для исключения повторений
    For i = LBound(arr) To UBound(arr)
      If Not OSD.exists(arr(i, 1)) Then OSD.Add CStr(arr(i, 1)), 0
    Next
    i = 2
    ' Выполняем анализ списка "Полный список"
    Set oRng = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
    For Each tmp In oRng
      sTemp = tmp
      If OSD.exists(sTemp) Then
          ' Помечаем на удаление желтым фоном дубликаты
          tmp.Interior.Color = 65535
      Else
          ' Выгружаем ответ в столбец C начиная с ячейки C2 с проверкой на уникальность.
'          If Not objItog.exists(sTemp) Then objItog.Add CStr(sTemp), 0: .Cells(i, 3).Value = sTemp
          ' Выгружаем ответ в столбец C начиная с ячейки C2.
          .Cells(i, 3).Value = sTemp
          i = i + 1
      End If
    Next
  End With
End With
Erase arr
Set oRng = Nothing
Set OSD = Nothing
Set objItog = Nothing
End Sub

arr = Range("A1:A9481").Value   ' получаем массив "ГДЕ ищем" из диапазона   
    For r = 1 To UBound(arr, 1) ' наполняем словарь из массива
        If dic.Exists(arr(r, 1)) Then MsgBox "The Value «" & x & "» have DUPLICATES!", vbCritical, "CLONES": Exit Sub
        dic.Add arr(r, 1), r    ' добавляем в словарь пару "значение - номер в массиве"
    Next r

arr = Range("A1:A9481").Value        ' получаем массив "ГДЕ ищем" из диапазона   
For r = 1 To UBound(arr, 1)          ' наполняем словарь из массива
  If not dic.Exists(arr(r, 1)) Then  ' исключаем дубликаты
     dic.Add Key:=arr(r, 1), Item:=r            ' добавляем в словарь пару "значение - номер в массиве"
  end if
Next r

'' Поиск, удаление имен в файле
Sub delNames()
Dim nms
  With ThisWorkbook
    For Each nms In .Names
        Debug.Print nms; Space(3); nms.Name
        nms.Delete
    Next
  End With
End Sub

'' Очистка страниц книги
Sub ClearSheets()
Dim sht
  With ThisWorkbook
    For Each sht In .Sheets
     Debug.Print sht.Name
     sht.Cells.ClearComments
     sht.Cells.ClearFormats
     sht.Cells.ClearHyperlinks
     sht.Cells.ClearNotes
     sht.Cells.ClearOutline
    Next
  End With
End Sub

#If VBA7 Then
  #If Win64 Then '' Windows x64, Office 2010 - 2013 и выше
    '''API получить координаты ячейки экселя на экране компьютера
    Public Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As LongPtr) As LongPtr
    '''тайм аут
    Public Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As LongPtr)
    '***** Работа с Clipboard Виндовс --- ClearClipboardApi
    Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
    Public Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
    '*****Для скрытого запуска документов (проверка орфографии) CheckSpellingText
    Public Declare PtrSafe Function CoAllowSetForegroundWindow Lib "ole32.dll" (ByVal pUnk As Object, ByVal lpvReserved As LongPtr) As LongPtr
    '***** Переключение раскладки на украинскую если в данный момент раскладка английская или русская
    Public Declare PtrSafe Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As LongPtr
    Public Declare PtrSafe Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As LongPtr, ByVal flags As LongPtr) As LongPtr
    '' Декларируем для Всех Форм кнопки Свернуть Развернуть ---- Константы остались в формах
    Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongLong
    Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As LongLong) As LongLong 'для отображения окон
    Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As LongPtr) As LongLong
    Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As LongPtr, ByVal dwNewLong As LongLong) As LongLong
    Public Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    '' Продублирована часть функций из класса clsFormChanger
'    Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
                                                                                     ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
'    Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
'    Public Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal bRevert As LongLong) As LongLong
'    Public Declare PtrSafe Function DeleteMenu Lib "user32" (ByVal hMenu As LongLong, ByVal nPosition As LongLong, ByVal wFlags As LongLong) As LongLong
'    Public Declare PtrSafe Function EnableWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal fEnable As LongLong) As LongLong
'    Public Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As LongLong, ByVal lpszExeFileName As String, ByVal nIconIndex As LongLong) As LongLong
'    Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As LongLong, ByVal wParam As Integer, ByVal lParam As LongLong) As LongLong
'    Public Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hWndLock As LongPtr) As LongPtr
    '' Сделать ексель  прозрачным во время работы с формой (быстро или постепенно)
  ' Public Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As LongPtr) As LongPtr
  ' Public Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As LongPtr, ByVal dwNewLong As LongPtr) As LongPtr
    Public Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As LongPtr, ByVal crKey As LongPtr, ByVal bAlpha As Byte, ByVal dwFlags As LongPtr) As LongPtr
    '' Отображения формы поверх всех окон:
    Public Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Public Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
                                                                ByVal x As LongPtr, ByVal y As LongPtr, ByVal cx As LongPtr, _
                                                                ByVal cy As LongPtr, ByVal wFlags As LongPtr) As LongPtr
 #Else '' Windows x86, Office 2010 - 2013 и выше
    '''API получить координаты ячейки экселя на экране компьютера
    Public Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As LongPtr
    '''тайм аут
    Public Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
    '***** Работа с Clipboard Виндовс --- ClearClipboardApi
    Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As LongPtr
    Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
    Public Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
    '*****Для скрытого запуска документов (проверка орфографии) CheckSpellingText
    Public Declare PtrSafe Function CoAllowSetForegroundWindow Lib "ole32.dll" (ByVal pUnk As Object, ByVal lpvReserved As LongPtr) As LongPtr
    '***** Переключение раскладки на украинскую если в данный момент раскладка английская или русская
    Public Declare PtrSafe Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As LongPtr
    Public Declare PtrSafe Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As LongPtr, ByVal flags As LongPtr) As LongPtr
    '' Декларируем для Всех Форм кнопки Свернуть Развернуть ---- Константы остались в формах
    Public Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
    Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As LongPtr) As LongPtr 'для отображения окон
    Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPtr
    Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    '' Продублирована часть функций из класса clsFormChanger
'    Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
                                                                                     ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
'    Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As LongPtr
'    Public Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As LongPtr) As LongPtr
'    Public Declare PtrSafe Function DeleteMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPosition As LongPtr, ByVal wFlags As LongPtr) As LongPtr
'    Public Declare PtrSafe Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As LongPtr) As LongPtr
'    Public Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As LongPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As LongPtr) As LongPtr
'    Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As LongPtr, ByVal wParam As Integer, ByVal lParam As LongPtr) As LongPtr
'    Public Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hWndLock As LongPtr) As LongPtr
      '' Сделать ексель  прозрачным во время работы с формой (быстро или постепенно)
  ' Public Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  ' Public Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As LongPtr, ByVal bAlpha As Byte, ByVal dwFlags As LongPtr) As LongPtr
    Public Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
    Public Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As LongPtr, _
                                                                ByVal x As LongPtr, ByVal y As LongPtr, ByVal cx As LongPtr, _
                                                                ByVal cy As LongPtr, ByVal wFlags As LongPtr) As LongPtr
  #End If
#Else 

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

strMyDocuments = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"

strMyDocuments = Application.ActiveWorkbook.Path & "\"

' переопределение массива и формирование шапки
  ReDim arr(1 To (iMaxRow / 2) + 1, 1 To 8)
  i = 1
  arr(i, 1) = "Источник": arr(i, 2) = "Категория": arr(i, 3) = "Название"
  arr(i, 4) = "Ссылка":  arr(i, 5) = "Сервер":  arr(i, 6) = "Обложка":  arr(i, 7) = "Статус"
  arr(i, 8) = "Не классифицировано"

Public Sub ParserASX_M3U()
'Основная процедура парсинга файлов ASX, m3u8
Dim i As Long, x As Long, n As Long
Dim tmp, temp
Dim arr1(), arr2()
Dim strTemp As String

' Получить коллекцию фалов для обработки.
' Используем внешнюю функцию диалог пользователя открыть файл, _
  дает возможность выбора (обработки) как одного так и всех файлов в папке.
Dim objFilesCollection As Collection
Set objFilesCollection = GetCollectionFilesDialog
If objFilesCollection.Count = 0 Then Exit Sub
' Перебор коллекции поиск фалов ASX и m3u
Dim objASXCollection As New Collection
Dim objM3UCollection As New Collection
For Each tmp In objFilesCollection
  If tmp Like "*.asx" Then
    objASXCollection.Add tmp
  ElseIf tmp Like "*.m3u*" Then
    objM3UCollection.Add tmp
  Else
  End If
Next tmp
Set objFilesCollection = Nothing

' Работаем с файлами ASX
' Считsваем данные файла внешней функцией
If objASXCollection.Count > 0 Then
  arr1 = GetCollectionASXfileText(objASXCollection)
  If LBound(arr1) > 0 Then
    arr1(1, 1) = "TITLE": arr1(1, 2) = "HREF"
    ' Выгружаем данные в новую книгу без сохранения
    Call CreateEXCELfile(arr1, "ASX files", 0)
  End If
End If
' Работаем с файлами m3u8
' Считsваем данные файла внешней функцией
If objM3UCollection.Count > 0 Then
  For Each tmp In objM3UCollection
    strTemp = CreateObject("Scripting.FileSystemObject").GetFileName(tmp)
    arr2 = GetCollectionM3UfileText(tmp)
    If LBound(arr2) > 0 Then
      ' Выгружаем данные в новую книгу без сохранения _
        для каждого файла создается отдельная новая книга
        Call CreateEXCELfile(arr2, strTemp, 1)
    End If
  Next
End If
Set objASXCollection = Nothing
Set objM3UCollection = Nothing
Erase arr1: Erase arr2
End Sub

Private Sub CreateEXCELfile(arrTemp, strNameSht As String, byteDataType As Byte)
''' ЗАГРУЖАЕМ ДАННЫЕ В СОЗДАННУЮ КНИГУ И РАБОТАЕМ С НЕЙ
' byteDataType - тип загружаемых данных (0 = массив файлов ASX, 1 = массив файлов m3u8)
Dim oExcelFile As Object
Dim iMaxRow As Long, iMaxClmn As Long
Dim i As Long, n As Long
iMaxRow = UBound(arrTemp, 1)
iMaxClmn = UBound(arrTemp, 2)

Workbooks.Add -4167 '=xlWBATWorksheet
''' Cоздаем новую книгу с одним листом
With CreateObject("Excel.Sheet"): Set oExcelFile = ActiveWorkbook: End With
With oExcelFile
  ActiveSheet.Name = strNameSht
  With .Sheets(strNameSht)
    ''' Формат ширин полей
    If byteDataType = 0 Then
      For Each oVl In .Range(.Cells(1, 1), .Cells(1, 1).Offset(, iMaxClmn - 1))
        Select Case oVl.Column
          Case Is = 1: oVl.ColumnWidth = 30: Case Is = 2: oVl.ColumnWidth = 145
        End Select
      Next
    ElseIf byteDataType = 1 Then
      For Each oVl In .Range(.Cells(1, 1), .Cells(1, 1).Offset(, iMaxClmn - 1))
        Select Case oVl.Column
          Case Is = 1: oVl.ColumnWidth = 15:  Case Is = 2: oVl.ColumnWidth = 25
          Case Is = 3: oVl.ColumnWidth = 45:  Case Is = 4: oVl.ColumnWidth = 45
          Case Is = 5: oVl.ColumnWidth = 25:  Case Is = 6: oVl.ColumnWidth = 25
          Case Is = 7: oVl.ColumnWidth = 15
        End Select
      Next
    Else
    End If
    ''' Выгружаем данные на лист
    .Range("A1").Resize(iMaxRow, iMaxClmn) = arrTemp '
    ''' Общее форматирование данных на листе
    ''' Форматируем шапку таблицы
    With .Range(.Cells(1, 1), .Cells(1, 1).Offset(, iMaxClmn - 1))
       .HorizontalAlignment = -4108 ' xlCenter
       .VerticalAlignment = -4108   ' xlCenter
       .Interior.Pattern = 1        ' xlSolid
       .Borders.LineStyle = 1       ' xlContinuous
       .Font.Bold = True            ' шрифт жирный
       .WrapText = True             ' перенос текста в ячейке
       .Interior.ColorIndex = 35
       .AutoFilter
    End With
    .Cells(2, 1).Select:  ActiveWindow.FreezePanes = True ''' Закрепить область на второй строке
    ''' Форматируем общие форматы таблицы
    With .Range(.Cells(2, 1), .Cells(iMaxRow, iMaxClmn))
        .HorizontalAlignment = -4131 'xlLeft
        .VerticalAlignment = -4108
        .Borders.LineStyle = 1
        .Interior.ColorIndex = -4105
        .WrapText = False
        .Font.Bold = False
        .Rows.AutoFit
        .Locked = True
    End With
  End With
End With
Erase arrTemp
End Sub

Private Function GetCollectionM3UfileText(strFileName) As Variant
' Функция обрабатывает содержимое файлов ASX возвращая массив
' Источник, Категория, Название, Ссылка, Сервер, Обложка, Статус
Dim oVl, iMaxRow As Long
Dim strLine1 As String, strLine2 As String
Dim arr(), arr1(0, 0), tmp, strTemp, strTemp1
Dim i As Long, n As Long

' Загрузка данных из файла в коллекции, считываем весь текс _
  Используется UTF8 для коррекктного чтения данных
  With CreateObject("ADODB.Stream")
    .Charset = "utf-8": .Mode = 3: .Type = 1
    .Open
    .LoadFromFile strFileName
    .Position = 0: .Type = 2
    strTemp = .ReadText
    oVl = Split(strTemp, vbCrLf)
    iMaxRow = UBound(oVl)
    .Close
    strTemp = vbNullString
  End With
  strFileName = CreateObject("Scripting.FileSystemObject").GetFileName(strFileName)
  ' переопределение массива и формирование шапки
  ReDim arr(1 To (iMaxRow / 2) + 1, 1 To 7)
  i = 1
  arr(i, 1) = "Источник": arr(i, 2) = "Категория": arr(i, 3) = "Название"
  arr(i, 4) = "Ссылка":  arr(i, 5) = "Сервер":  arr(i, 6) = "Обложка":  arr(i, 7) = "Статус"
    
  For n = 1 To iMaxRow Step 2
    If oVl(n) Like "*EXTINF*" Then
      i = i + 1
      strTemp = Split(oVl(n), ",", -1, 1)
      '"Источник"
      arr(i, 1) = strFileName
      '"Категория"
        strTemp(0) = Replace(strTemp(0), "#EXTINF:-1 group-title=", "", 1, -1, 1)
        strTemp(0) = Replace(strTemp(0), Chr(34), "", 1, -1, 1)
        
        If strTemp(0) Like "*tvg-logo*" Then
          strTemp1 = Split(strTemp(0), "tvg-logo=", -1, 1)
          arr(i, 2) = Trim(strTemp1(0))
          '"Обложка"
          arr(i, 6) = Trim(strTemp1(1))
        Else
          arr(i, 2) = Trim(strTemp(0))
          arr(i, 6) = "-"
        End If
      '"Название"
      If strTemp(1) Like "*===*" Then strTemp(1) = Replace(strTemp(1), "=", "", 1, -1, 1)
      arr(i, 3) = strTemp(1)
      ' "Ссылка"
      If oVl(n + 1) Like "*http*" Then arr(i, 4) = oVl(n + 1)
      ' "Сервер"
        strTemp = Split(oVl(n + 1), "/", -1, 1)
        arr(i, 5) = strTemp(2)
      
      ' "Статус"
      arr(i, 7) = "I don't know"
      
    End If
  Next n
Erase oVl: oVl = Empty
strFileName = vbNullString
If i > 0 Then GetCollectionM3UfileText = arr Else GetCollectionM3UfileText = arr1
Erase arr
End Function

Private Function GetCollectionASXfileText(objColl As Object) As Variant
' Функция обрабатывает содержимое файлов ASX возвращая массив
Dim strBuf As String, intFreeFile As Long, Lines() As String
Dim strLine1 As String, strLine2 As String
Dim arr(), arr1(0, 0), tmp, temp
Dim i As Long, n As Long
ReDim arr(1 To objColl.Count + 1, 1 To 2): n = 1
For Each tmp In objColl
  intFreeFile = FreeFile
  Open tmp For Binary As #intFreeFile
  strBuf = Space(LOF(intFreeFile))
  Get #intFreeFile, , strBuf
  Close #intFreeFile
  Lines = Split(strBuf, vbCrLf)
  strBuf = vbNullString
    For i = 0 To UBound(Lines)
      If Lines(i) Like "*<TITLE>*" Then
        Lines(i) = Replace(Lines(i), "<Entry>", "", 1, -1, vbTextCompare)
        Lines(i) = Replace(Lines(i), "<TITLE>", "", 1, -1, vbTextCompare)
        Lines(i) = Replace(Lines(i), "</TITLE>", "", 1, -1, vbTextCompare)
        Lines(i) = Trim(Lines(i))
        strLine1 = Lines(i)
      ElseIf Lines(i) Like "*<ref*" Then
        Lines(i) = Replace(Lines(i), "<ref HREF=", "", 1, -1, vbTextCompare)
        Lines(i) = Replace(Lines(i), "/>", "", 1, -1, vbTextCompare)
        Lines(i) = Replace(Lines(i), Chr(34), "", 1, -1, vbTextCompare)
        Lines(i) = Trim(Lines(i))
        strLine2 = Lines(i)
      Else
      End If
    Next i
    If Len(strLine1) > 0 And Len(strLine2) > 0 Then
      n = n + 1
      arr(n, 1) = strLine1: arr(n, 2) = strLine2
    End If
    strLine1 = vbNullString: strLine2 = vbNullString
Next
If i > 0 Then GetCollectionASXfileText = arr Else GetCollectionASXfileText = arr1
Erase arr
End Function

Private Function GetCollectionFilesDialog() As Collection
''' Функция диалога выбора файлов FileDialog(msoFileDialogFilePicker)
''' Возвращает коллекцию файлов выбраных пользователем
Dim objColl As New Collection
Dim intSelectFile As Long
Dim strMyDocuments
strMyDocuments = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"
  With Application.FileDialog(3)
      .AllowMultiSelect = True
      .Title = "Выбрать файлы ASX, m3u8 для обработки"
      .Filters.Clear
      .Filters.Add "All files", "*.*", 1
      .Filters.Add "ASX files", "*.asx", 2
      .Filters.Add "m3u8 files", "*.m3u8", 3
      .FilterIndex = 3
      .InitialFileName = strMyDocuments & "*.*.*.*"
      .InitialView = 2
      If .Show = 0 Then
        Set GetCollectionFilesDialog = objColl
        Exit Function
      End If
      'цикл по коллекции выбранных в диалоге файлов, считываем полный путь к файлу
      For intSelectFile = 1 To .SelectedItems.Count
          objColl.Add .SelectedItems(intSelectFile)
      Next
      Set GetCollectionFilesDialog = objColl
  End With
End Function

Sub ReadTextFileFSO()
'''Чтение всего текстового файла
Dim objFile As Object, objFS As Object
Dim strFullFileName As String '' полный путь к файлу
Dim strRead As String
strFullFileName = "D:\Users\TSN\Desktop\WWWList.txt"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.OpenTextFile(strFullFileName, 1, True)
    strRead = objFile.ReadAll ''' копируем
              objFile.Close
   ActiveCell.Value = strRead ''' вставляем
Set objFS = Nothing: Set objFile = Nothing
strRead = vbNullString
End Sub