Извлечение цены с web страницы

Пользователь

Сообщений: 206 Регистрация: 17.11.2013

01.10.2021 10:21:56

Добрый день. Хотел автоматизировать обновление цен вот с этого сайта https://tot-kom.ru/catalog/mebelnaya-furnitura/shchetochnye-uplotniteli/derzhatel-schetochnogo-uplot... Но беда в том что не получается это сделать. На других сайтах успешно отрабатывал вот такой метод с сайта :https://excelvba.ru/code/GetWebPageText У меня получалось найти интересующие данные, если знаешь ссылку.. Сейчас в тупике и не пойму что не так... Большая просьба дать наводку на решение проблемы..

Alemox

Пользователь

Сообщений: 2184 Регистрация: 25.02.2013

01.10.2021 11:02:12

Код

Sub GET_Internet()
Dim XMLHTTP As Object
Dim Myurl$, Txt$, Str$
Dim n&, k&

Myurl = "https://tot-kom.ru/catalog/mebelnaya-furnitura/shchetochnye-uplotniteli/derzhatel-schetochnogo-uplotnitelya-absolut/?sphrase_id=1571"
'Myurl = "https://tot-kom.ru/catalog/mebelnaya-furnitura/shchetochnye-uplotniteli/schetochnyy-uplotnitel-6mm-bez-kleya-seryy-325m-tecseal/"

Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
XMLHTTP.Open "GET", Myurl, False
XMLHTTP.send
If XMLHTTP.Status = 200 Then
    Txt = XMLHTTP.responseText
    n = InStr(1, Txt, "price", vbTextCompare)
    n = InStr(n, Txt, "<p>", vbTextCompare) + 3
    k = InStr(n, Txt, "<span>", vbTextCompare)
    Str = Replace(Trim(Mid(Txt, n, k - n)), ".", ",")
    MsgBox Str & " Рублёв"
    'Debug.Print Txt
Else
    MsgBox "Отсутствует соединение..."
End If
Set XMLHTTP = Nothing
End Sub

Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.