Аналог функции importXML(google sheets) в Excel

Public Function ImportXML(ByVal url As String, ByVal XPath As String) As Variant
On Error GoTo errHandle
    Dim pDoc As Object, t As Single, pNode As Object
    Set pDoc = CreateObject("MSXML2.DOMDocument")
    t = Timer
    pDoc.Load url
    Do Until (pDoc.readyState = 4) Or ((Timer - t) > 1)
        DoEvents
    Loop
    If pDoc.readyState <> 4 Then ImportXML = CVErr(XlCVError.xlErrRef): Exit Function
    Set pNode = pDoc.SelectSingleNode(XPath)
    If pNode Is Nothing Then ImportXML = CVErr(XlCVError.xlErrNull): Exit Function
    ImportXML = pNode.Text
Exit Function
errHandle:
    ImportXML = CVErr(XlCVError.xlErrNA)
End Function

Sub ExtractDataFromWeb()
    Dim URL As String
    Dim XMLHTTP As Object
    Dim HTMLDoc As Object
    Dim XPath As String
    Dim Elements As Object
    Dim Element As Object
    Dim Result As String
    
    ' Указываем URL и XPath
    URL = Range("B1").Value
    XPath = "//div[@class='col-6 col-md-2 d-flex align-items-end justify-content-end price']"
    
    ' Создаем объект XMLHTTP для выполнения HTTP-запроса
    Set XMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    XMLHTTP.Open "GET", URL, False
    XMLHTTP.send
    
    ' Создаем объект HTMLDoc для работы с содержимым веб-страницы
    Set HTMLDoc = CreateObject("htmlfile")
    HTMLDoc.body.innerHTML = XMLHTTP.responseText
    
    ' Извлекаем элементы по XPath
    Set Elements = HTMLDoc.getElementsByTagName("div")
    For Each Element In Elements
        If Element.className = "col-6 col-md-2 d-flex align-items-end justify-content-end price" Then
            Result = Element.innerText
            Exit For
        End If
    Next Element
    
    ' Выводим результат
    Range("C1").Value = Result
    
    ' Очищаем объекты
    Set XMLHTTP = Nothing
    Set HTMLDoc = Nothing
End Sub

Sub Parsing()
    Dim i&, lastRow&, arrIn(), arrOut()
    
    lastRow = Columns(7).Find(What:="*", SearchDirection:=xlPrevious).Row
    arrIn = Range(Cells(2, 7), Cells(lastRow, 9)).Value
    ReDim arrOut(1 To lastRow - 1, 1 To 1)
    
    For i = 1 To lastRow - 1
        arrOut(i, 1) = ExtractDataFromWeb(CStr(arrIn(i, 1)), CStr(arrIn(i, 3)))
    Next
    
    'Вывод результата в 10 столбец "j"
    Range(Cells(2, 10), Cells(lastRow, 10)).Value = arrOut
End Sub
 
Function ExtractDataFromWeb(URL$, XPath$)
    Dim XMLHTTP As Object
    Dim HTMLDoc As Object
    Dim Elements As Object
    Dim Element As Object
    
    ' Создаем объект XMLHTTP для выполнения HTTP-запроса
    Set XMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    XMLHTTP.Open "GET", URL, False
    XMLHTTP.send
    
    ' Создаем объект HTMLDoc для работы с содержимым веб-страницы
    Set HTMLDoc = CreateObject("htmlfile")
    HTMLDoc.body.innerHTML = XMLHTTP.responseText
    
    ' Извлекаем элементы по XPath
    Set Elements = HTMLDoc.getElementsByTagName("div")
    For Each Element In Elements
        If Element.className = "col-6 col-md-2 d-flex align-items-end justify-content-end price" Then
            ExtractDataFromWeb = Element.innerText 'Возврат результата функцией
            Exit For
        End If
    Next Element
End Function

Sub ExtractDataFromWeb2()
    Dim i&, lastRow&, arrIn() ', arrOut()
    Dim URL$, XPath$
    Dim XMLHTTP As Object
    Dim HTMLDoc As Object
    Dim Elements As Object
    Dim Element As Object
    
    Set XMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0") ' Создаем объект XMLHTTP для выполнения HTTP-запроса
    Set HTMLDoc = CreateObject("htmlfile")                 ' Создаем объект HTMLDoc для работы с содержимым веб-страницы
    lastRow = Columns(7).Find(What:="*", SearchDirection:=xlPrevious).Row
    arrIn = Range(Cells(2, 7), Cells(lastRow, 9)).Value
    ReDim arrOut(1 To lastRow - 1, 1 To 1)
    
    For i = 1 To lastRow - 1
        URL = arrIn(i, 1)
        XPath = Mid(arrIn(i, 3), 15, Len(arrIn(i, 3)) - 16)
        
        XMLHTTP.Open "GET", URL, False
        XMLHTTP.send
        
        HTMLDoc.body.innerHTML = XMLHTTP.responseText
        
        Set Elements = HTMLDoc.getElementsByTagName("div") ' Извлекаем элементы по XPath
        For Each Element In Elements
            If Element.className = XPath Then
'                arrOut(i, 1) = Element.innerText
                Cells(i + 1, 10) = Element.innerText       ' Вывод результата в столбец "j"
                Exit For
            End If
        Next Element
    Next i
'    Range(Cells(2, 10), Cells(lastRow, 10)).Value = arrOut
End Sub

Sub ExtractDataFromWeb2()
    Dim i&, lastRow&, arrIn()
    Dim URL$, XPath$, Tag$, pos&
    Dim XMLHTTP As Object
    Dim HTMLDoc As Object
    Dim Elements As Object
    Dim Element As Object
    
    Set XMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0") ' Создаем объект XMLHTTP для выполнения HTTP-запроса
    Set HTMLDoc = CreateObject("htmlfile")                 ' Создаем объект HTMLDoc для работы с содержимым веб-страницы
    lastRow = Columns(7).Find(What:="*", SearchDirection:=xlPrevious).Row
    arrIn = Range(Cells(2, 7), Cells(lastRow, 9)).Value    
    
    For i = 1 To lastRow - 1
        URL = arrIn(i, 1)
        pos = InStr(3, arrIn(i, 3), "[")
        Tag = Mid(arrIn(i, 3), 3, pos - 3)
        pos = InStr(pos, arrIn(i, 3), "'")
        XPath = Mid(arrIn(i, 3), pos + 1, Len(arrIn(i, 3)) - pos - 2)
        
        DoEvents
        XMLHTTP.Open "GET", URL, False
        XMLHTTP.send
        
        HTMLDoc.body.innerHTML = XMLHTTP.responseText
        
        Set Elements = HTMLDoc.getElementsByTagName(Tag) ' Извлекаем элементы по XPath
        For Each Element In Elements
'            Debug.Print Element.className
            If Element.className = XPath Then
                DoEvents
                Cells(i + 1, 10) = Element.innerText     ' Вывод результата в столбец "j"
                Exit For
            End If
        Next Element
    Next i
End Sub

XMLHTTP.setrequestheader "User-Agent", "Mozilla/5.0 (compatible;MSIE 6.0; WindowsNT 10.0))"
XMLHTTP.send

Sub ExtractDataFromWeb3()
    Dim i&, lastRow&, arrIn()
    Dim URL$, XPath$, XPtArr$(), rsTxt$, j&, pos&
    Dim XMLHTTP As Object 'IServerXMLHTTPRequest2
    Dim HTMLDoc As Object 'HTMLDocument
    Dim Elements As Object 'DispHTMLElementCollection
    Dim Element As Object
    Dim xmldoc As Object 'DOMDocument
    
    Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False
    Set XMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0") ' Создаем объект XMLHTTP для выполнения HTTP-запроса
    Set HTMLDoc = CreateObject("htmlfile")                 ' Создаем объект HTMLDoc для работы с содержимым веб-страницы
    lastRow = Columns(7).Find(What:="*", SearchDirection:=xlPrevious).Row
    arrIn = Range(Cells(2, 7), Cells(lastRow, 9)).Value
    
    For i = 1 To lastRow - 1
        URL = arrIn(i, 1)
        XPath = XMLToHtmlXPath(CStr(arrIn(i, 3)))
        XPtArr = Split(XPath, "]")
                
        DoEvents
        XMLHTTP.Open "GET", URL, False
        XMLHTTP.send
        
        rsTxt = XMLHTTP.responseText
        
        pos = 1
        For j = 0 To UBound(XPtArr) - 1
            pos = InStr(pos, rsTxt, XPtArr(j), vbTextCompare)
        Next
        
        If pos Then
            pos = InStr(pos, rsTxt, ">") + 1
        Else
            MsgBox "Неправильный ответ сервера"
            GoTo Continue
        End If
        
        DoEvents
        Cells(i + 1, 10) = Mid(rsTxt, pos, InStr(pos, rsTxt, "<") - pos)
        
Continue:    Next i
End Sub

Function XMLToHtmlXPath$(XPath$)
    XPath = Replace(XPath, "/", "<", 2)
    XPath = Replace(XPath, "[@", " ")
    XPath = Replace(XPath, "'", """")
    XMLToHtmlXPath$ = XPath
End Function