Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Парсинг данных с сайта со скриптами.
 
#1
13.02.2020 18:05:58
Добрый день,

По данной ссылке пытаюсь получить  стоимость товара ($99.97).
Т.к сначала необходимо дождаться срабатывания всех скриптов, то делаю это через IE.
Однако, несмотря на
Код
While ie.ReadyState <> 4
    DoEvents
Wend
Страница все равно не успевает прогрузиться (как мне кажется) и получается, что невозможно вытянуть цену.
Весь код предельно прост:
Код
Sub ImportData()
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    sURL = "https://www.walmart.ca/en/ip/coffee-table-rustic-oak/6000199108427"
    ie.Navigate sURL
    
    While ie.ReadyState <> 4
        DoEvents
    Wend
    
    Strh = ie.Document.body.innerText
    
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True
    objRegExp.Pattern = "(<span class=""css-2vqe5n esdkp3p0"".*?>)(.*?)(</span>)"
    
    If objRegExp.Execute(Strh).Count <> 0 Then
        MsgBox objRegExp.Execute(Strh).Item(0).submatches.Item(1)
    End If
End Sub  
Скрытый текст


Есть идеи, каким образом можно вытянуть цену?
 
 
 
#2
13.02.2020 19:24:13
В принципе там есть POST-запрос на прайс можно через него тянуть. Проверил некоторые коды, но надо тестировать.
Код
Sub PictureInternet()
Dim XMLHTTP As Object
Dim Myurl$, Txt$, Artikul$

Artikul = "6000198185490"
Myurl = "https://www.walmart.ca/api/product-page/price-offer"
Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
XMLHTTP.Open "POST", Myurl, False
XMLHTTP.send "{""availabilityStoreId"":""3124"",""fsa"":""P7B"",""experience"":""whiteGM"",""products"":[{""productId"":""" & Artikul & """,""skuIds"":[""" & Mid(Artikul, 1, Len(Artikul) - 1) & CInt(Right(Artikul, 1)) + 1 & """]}],""lang"":""en""}"
If XMLHTTP.Status = 200 Then
    Txt = XMLHTTP.responseText
    Debug.Print Txt
Else
    MsgBox "Отсутствует соединение..."
End If
Set XMLHTTP = Nothing
End Sub
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
 
 
#3
13.02.2020 19:45:18
В Power Query тоже что то получилось
Код
let
    Source = {
              "https://www.walmart.ca/en/ip/coffee-table/6000199157960",
              "https://www.walmart.ca/en/ip/coffee-table-rustic-oak/6000199108427",
              "https://www.walmart.ca/en/ip/coffee-table-canyon-walnut/6000199107072",
              "https://www.walmart.ca/en/ip/coffee-table-espresso/6000199217059",
              "https://www.walmart.ca/en/ip/coffee-table/6000199156809"},
    #"Converted to Table" = Table.FromList(Source, Splitter.SplitByNothing()),
    #"Added Custom" = Table.AddColumn(#"Converted to Table", "Цена", each let
    Source = Table.FromColumns({Lines.FromBinary(Web.Contents([Column1]))}),
    Insert = Table.AddColumn(Source, "a", each Text.BetweenDelimiters([Column1], """upc"":[""", """]"), type text),
    Filter = Table.SelectRows(Insert, each   [a] <> "")[a]{0},
    Custom1 = Json.Document(Web.Contents("https://www.walmart.ca/api/product-page/find-in-store?latitude=48.4120872&longitude=-89.2413988&lang=en&upc="&Filter)),
    info = Custom1[info],
    info1 = info{0}[sellPrice]
in
    info1)
in
    #"Added Custom"
 
 
 
#4
14.02.2020 09:53:46
Код
Sub ImportData()
    Dim s As String
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    sURL = "https://www.walmart.ca/en/ip/coffee-table-rustic-oak/6000199108427"
    IE.Navigate sURL
    Application.Wait (Now() + TimeValue("00:00:05"))
    t = IE.document.body.innerHTML
    Dim REGEXP As Object
    Set REGEXP = CreateObject("VBScript.RegExp")
    REGEXP.IgnoreCase = True
    REGEXP.Global = False
    REGEXP.MultiLine = True
    REGEXP.Pattern = "\$[\d.]*"
    If REGEXP.test(t) Then
       Cells(1, 1) = REGEXP.Execute(t)(0)
    End If
End Sub
 
 
 
Страницы: 1
Наверх