CSS Селектор Альтернатива QuerySelector - PullRequest
Новая
       35

CSS Селектор Альтернатива QuerySelector

0 голосов
/ 03 апреля 2020

Я много и много искал, чтобы найти материал о том, как получить метаданные с использованием XMLHTTP. И я думаю, что это невозможно сделать, используя метод раннего связывания. Единственный подход, который сработает, это поздняя привязка CreateObject("HTMLFile") и работа с той HTML, которая является поздней привязкой. Недостатком этого подхода является то, что он не поддерживает использование QuerySelector или QuerySelectorAll .. Теперь я пытаюсь найти альтернативу этому селектору CSS .. без использования QuerySelector

Set post = .querySelector("table div span[itemprop='lowPrice']")

Возникает ошибка .. и я не могу найти более простой способ найти элемент Вот содержание HTML

image

Это целое HTML https://pastebin.com/Dgu1wk2b

Вот код до сих пор 

Sub MyTest()
Dim source      As Object
Dim obj         As Object
Dim resp        As String
Dim post As Object
Dim a, i As Long

With CreateObject("MSXML2.xmlHttp")
    .Open "GET", "https://krmivo-psy.heureka.cz/brit-premium-by-nature-adult-l-15-kg/specifikace/#section", False
    .send
    resp = .responseText
End With

With CreateObject("HTMLFile")
    .write resp
    Set post = .getElementsByTagName("meta")

    For i = 0 To post.Length - 1
        On Error Resume Next
        Debug.Print post.item(i).getAttribute("name")
        If post.item(i).getAttribute("name") = "gtm:product_id" Then
            Cells(2, 1).Value = post.item(i).Value
        End If
        If post.item(i).getAttribute("name") = "gtm:product_name" Then
            Cells(2, 3).Value = post.item(i).Value
        End If
        If post.item(i).getAttribute("name") = "gtm:product_brand" Then
            Cells(2, 4).Value = post.item(i).Value
        End If
        On Error GoTo 0
    Next i

    Set post = Nothing

    Set post = .getElementsByTagName("link")
    For i = 0 To post.Length - 1
        On Error Resume Next
        If post.item(i).getAttribute("rel") = "canonical" Then
            Cells(2, 2).Value = post.item(i).href
        End If
        On Error GoTo 0
    Next i

    'I am stuck here
    'Set post = .querySelector("table div span[itemprop='lowPrice']")
    'Debug.Print .getElementsByTagName("table")(0).innerHTML
End With

End Sub

Ответы [ 2 ]

1 голос
/ 04 апреля 2020

Как вы обнаружили, HEAD информация тега (где живет мета-материал) удаляется при использовании document.body.innerHTML = .responseText с ранним связыванием MSHTML.HTMLDocument. Что бы вы ожидали, учитывая то, что вы населяете (document.body). Вот почему вы не можете выбрать информацию meta. С вашим поздним ограничением HTMLFile (где вы не можете использовать querySelector) вы используете метод .write, который записывает в ваш документ (HTMLFile) и, таким образом, сохраняет информацию HEAD.

Необходимо убедиться, что информация HEAD заканчивается в тегах BODY. Либо как часть тела ответа, либо как извлеченный HEAD, объединенный с новыми тегами BODY и записанный в HTMLDocument, если вы хотите использовать раннее связывание.

Например, для ясности пишу HEAD информация между BODY только теги (без остатка существующего ответа) 

Option Explicit

Public Sub MetaInfoEarlyBound()
    Dim html As MSHTML.HTMLDocument, htmlHead As MSHTML.HTMLDocument, xhr As MSXML2.XMLHTTP60
    Dim re As VBScript_RegExp_55.RegExp

    Set htmlHead = New MSHTML.HTMLDocument
    Set html = New MSHTML.HTMLDocument
    Set xhr = New MSXML2.XMLHTTP60    
    Set re = New VBScript_RegExp_55.RegExp

    re.Pattern = "<head>([\s\S]+)<\/head>"

    With xhr
        .Open "GET", "https://krmivo-psy.heureka.cz/brit-premium-by-nature-adult-l-15-kg/specifikace/#section", False
        .send
        htmlHead.body.innerHTML = Replace$(Replace$(re.Execute(.responseText)(0), "<head>", "<body>"), "</head>", "</body>")
        html.body.innerHTML = .responseText
    End With

    Debug.Print htmlHead.querySelector("[name='gtm:product_price']").Value
    Debug.Print html.querySelector("[itemprop=lowPrice]").innerText

End Sub

В качестве отступления, я добавляю два более коротких метода (чем текущий другой ответ), чтобы достичь вашей цели с поздним связыванием. Обратите внимание, я закомментировал один из них. 

Public Sub MetaInfoLateBound()
    Dim resp As String

    With CreateObject("MSXML2.xmlHttp")
        .Open "GET", "https://krmivo-psy.heureka.cz/brit-premium-by-nature-adult-l-15-kg/specifikace/#section", False
        .send
        resp = .responseText
    End With

    With CreateObject("HTMLFile")

        .write resp

'        Dim post As Object
'
'        Set post = .getElementById("new-pd")
'        Debug.Print post.PreviousSibling.PreviousSibling.getElementsByTagName("span")(0).innertext
'
        Dim metas As Object, i As Long

        Set metas = .getElementsByTagName("meta")

        For i = 0 To metas.Length - 1
            If metas.Item(i).Name = "gtm:product_price" Then
                Debug.Print metas.Item(i).Value
                Exit For
            End If
        Next
    End With
End Sub
1 голос
/ 04 апреля 2020

Попробуйте это: 

With CreateObject("HTMLFile")
    .Open
    .write resp
    .Close

    For Each tbl In .getElementsByTagName("table")
       For Each dv In tbl.getElementsByTagName("div")
            If dv.getattribute("itemprop") = "offers" Then     '<<EDIT
                For Each spn In dv.getElementsByTagName("span")
                    attr = ""
                    attr = spn.getattribute("itemprop")
                    If Len(attr) > 0 Then
                        If attr = "lowPrice" Then
                            Debug.Print spn.outerhtml
                            Debug.Print spn.innerText
                        End If
                    End If
                Next spn
            End If
        Next dv
    Next tbl
End With
...