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

Страницы: 1
Авторизация на сайте через макрос 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 страницы
 
Ситуация в следующем, есть непрерывно работающий макрос по парсингу вебстраницы (регулярные запросы на сайт, извлечение в виде текста, и в случае поступления новой информации на этом сайте, передаче этой новой информации в группу телеграмм), иногда рандомно может 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
Наверх