Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Рандомная ошибка в работющем кода парсинга web страницы
 
Спасибо огромное за помощь, Дообер и Игорь, буду тестировать оба вариант и "перебором" от Дообера и "регулярные выражения для поиска тегов" от Игоря
Метод Дообера в тесте, а вот по методу Игоря один маленький вопрос по моему коду, мой код в строке prisezz = GetTags(pagelink, "td", "class", "prisez", "ConvertToText 1") получаю текст в виде например "10 грн/км  7 000 грн, нал,", а мне нужно только "7 000 грн, нал".Буду очень признателен за помощь
Ссылка на страницу от куда беру данные https://mob.della.ua/details/?code=22041141039849104&geo=abdwsngeflolh6k0m

На всякий случай часть моего кода
Код
pageText = getText(url)
         link$ = "https://mob.della.ua/" + GetTags(pageText, "a", "class", "anchor", "href 1") 'ññûëêà ïîäðîáíåå
         pagelink = getText("https://mob.della.ua/" + GetTags(pageText, "a", "class", "anchor", "href 1"))
         Data = GetTags(pagelink, "td", "class", "fcx datePair", "ConvertToText 1")
         Data = Data + "  "
         Marhrut1 = GetTags(pagelink, "td", "class", "fcg vat", "ConvertToText 1")
         Marhrut2 = GetTags(pagelink, "td", "class", "fcg vat", "ConvertToText 3")
         gruz = GetTags(pagelink, "span", "class", "s5", "ConvertToText 1")
         gruz = gruz + "  "
         ves = GetTags(pagelink, "span", "class", "s5", "ConvertToText 2")
         obem = GetTags(pagelink, "span", "class", "s5", "ConvertToText 3")
         tip = GetTags(pagelink, "td", "class", "extra", "ConvertToText 1")
         tip = tip + "  "
         prisezz = GetTags(pagelink, "td", "class", "prisez", "ConvertToText 1")

    Marhrut = Marhrut1 + " - " & Marhrut2 + "  "
    
    zayavka = Data & Marhrut & gruz & ves & obem & tip & prisezz & url
Авторизация на сайте через макрос VBA
 
Думаю для здешних профи вопрос очень простой, но для меня есть сложности. Нашел код на просторах для авторизации на сайте, логин и пароль вроде подхватывает а вот как привязать в "клик на сайте войти"  и прописать это в моем коде не знаю
мой код(точнее найденный):
Код
  Private Sub Test()
   
    Set objIE = CreateObject("InternetExplorer.Application")
    With objIE
        .Visible = True
        .navigate "https://mob.della.by/login/"
        Do While .Busy Or _
           .readyState <> 4
            DoEvents
        Loop
        Set Login1_UserName = .document.getElementById("Login")
        Login1_UserName.Value = "brestkufar+11@yandex.by"
        Set Login1_Password = .document.getElementById("Password")
        Login1_Password.Value = "12345678"
        Set LoginButton = .document.getElementById("ctl00_cButton") 'вот в этих двух строчках и 
        LoginButton.Click                                           ' и не знаю что прописать с привязкой к исходному коду страницы авторизации                       
        Do While .Busy Or _
           .readyState <> 4
            DoEvents
        Loop
    End With
    Set objIE = Nothing
End Sub


ниже кусок исходного кода страницы для авторизации( надеюсь этого куска хватит что бы разобраться):
либо мойжно зайти по адресу https://mob.della.by/login/ и посмотеть в исходном коде кому нужно что

  td><div id='vseya'>
<div class="bottomDots enter" id='headerLogin'>Вход в систему</div>
<div id='controls' class="bottomDots">
<form id='logForm' method="POST" action="/login/?key=1644507927320">
<div class="login">Логин:</div>
<input class="pwd" type="text" name="login" id="login" value="">
<div class="login pwd">Пароль:</div>
<input class="pwd" type="password" name="password" id="password">
<div class="enterBtn">
<input class="button" type="submit" value="Войти">
</div>
<input type="hidden" name="login_mode" value="enter">
<input type="hidden" name="isMobile" value="1">
</form>
<span id="errorMes"></span>
</div>
<div id='napomnit' class="bottomDots">
<span class="forget">


Рандомная ошибка в работющем кода парсинга web страницы
 
"fraht" это одна из переменных таких как Data, marshrut, gruz, и которой может присваиваться значение либо "стоимость перевозки, либо ******* в случает отсутствия стоимости.
Т.е вы считаете что в этом причина, ну тогда почему это возникает от случая к случаю( хотя "стоимость" и "******" чередуются) и почему ошибку выдает в строке "Data" которая выше?
Внес вашу поправку в код, но почему то переменным Data, marshrut, gruz не присваиваются ни какие текстовые значения, либо возможно я не правильно объединил два куса кода.Буду очень признателен если подправите полный код и так как вы уже я вижу разбирались в коде той страницы грузоперевозок, может поможете еще выдернуть информацию по клику "подробнее" на этом сайте
Изменено: IgorBrest - 10.02.2022 13:40:06
Рандомная ошибка в работющем кода парсинга web страницы
 
это тэг на странице, по содержимому которого и присваивается значение переменных Data, marshrut, gruz, fraht, и они принимают соответсвенно значение например "09.02", "Москва-Питер", "коробки 100кг", "6000 рублей", не понятно почему может работать день, а потом бах , и ошибка.При чем знаю как там вносятся эти "Data, marshrut, gruz, fraht" на сайт, все делает сам сайт по своим шаблонам, ни каких значение от себятины от пользователя типа символов, пробелов или других знаком не бывает
Изменено: vikttur - 09.02.2022 17:10:06
Рандомная ошибка в работющем кода парсинга web страницы
 
Ситуация в следующем, есть непрерывно работающий макрос по парсингу вебстраницы (регулярные запросы на сайт, извлечение в виде текста, и в случае поступления новой информации на этом сайте, передаче этой новой информации в группу телеграмм), иногда рандомно может 1 раз в сутки или 1 раз в 4-5 часов выскакивает ошибка " vba excel 91 object variable or with block variable not set" в строке помеченной в коде ниже и выполнение макроса соответственно останавливается что есть очень плохо так как я не могу постоянно отслеживать эту ошибку. Может есть мысли в чем причина?.P.S прошу не судить строго по коду, слепил из того что нашел в сети
Код
    

Public Function EncodeUTF8(str As String)
    Dim ScriptEngine As Object
    Set ScriptEngine = CreateObject("ScriptControl")
    ScriptEngine.Language = "JScript"
    EncodeUTF8 = ScriptEngine.Run("encodeURIComponent", str)
End Function

Function getText(ByRef url As String) As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .send Null
        getText = .responseText
    End With
End Function

Sub Test()
    Dim myFile As Object, myTag As Object 
    Dim pageText As String, Message As String
    Const url As String = "https://mob.della.ua/results/?geo=a164bdeflolh6k0m"
    Dim Data As String, marshrut As String, gruz As String, fraht As String
   
       Application.OnTime Now + TimeValue("00:00:05"), "test"
       
        pageText = getText(url)
        
        Set myFile = CreateObject("HTMLFile")
        myFile.body.innerHTML = pageText
        Set myTag = myFile.getElementsByTagName("td")
        
        Data = myTag(6).innerText   '6 дата   ВОТ ЗДЕСЬ И ВЫСКАКИВАЕТ ОШИБКА!!!, если убрать переменную Дата, то будет уже ошибка в след. в marshrut
        Data = Data + "  "
        marshrut = myTag(7).innerText '7 маршрут
        marshrut = marshrut + "  "
        gruz = myTag(9).innerText  '9 груз
        gruz = gruz + "  "
        fraht = myTag(10).innerText '10 фракт
        fraht = fraht + "  "
    
    txt$ = Data & marshrut & gruz & fraht & url
    If txt$ <> [A5] Then [A5] = txt$ Else End
    Message = [A5]
    Message = EncodeUTF8(Message)
    
sURI = "https://api.telegram.org/bot5036799064:AAEWVM0WlYPDyWLJobanFv47FKv_D-YUFd8/sendMessage?chat_id=-1001707707704&text=" & Message
  
On Error Resume Next
Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
If Err.Number <> 0 Then
Set oHttp = CreateObject("MSXML.XMLHTTPRequest") 'можно ли здесь "MSXML.XMLHTTPRequest" заменить на "MSXML2.XMLHTTP"
                                                  ' т.к MSXML.XMLHTTPRequest не работает или у них разное назнаечение?
End If
On Error GoTo 0
If oHttp Is Nothing Then Exit Sub
oHttp.Open "GET", sURI, False
oHttp.send
Set oHttp = Nothing
End Sub
Страницы: 1
Наверх