Авторизация на сайте MSXML2.XMLHTTP

Авторизация на сайте MSXML2.XMLHTTP, Авторизация и копирования кода страницы в переменную

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

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

16.04.2023 00:03:30

Здравствуйте, коллеги
Прошу помочь с кодом.

Пытаюсь авторизоваться на сайте, чтобы получить информацию о товаре, которая без авторизации недоступна.
Ссылку-путь для авторизации я нашел, а вот как передать информацию о логине и пароле не знаю.

Код

Sub Parser()
  
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    Set objRegExp = CreateObject("VBScript.RegExp")
      
    URL = "https://www.sima-land.ru/4794023/nabor-dlya-sortirovki-sorter-bomboshki/"
    URL_autorization = "https://www.sima-land.ru/api/v3/login-form/"
    entity = "******"
    Password = "******"
    g_recaptcha_response = " "
    PostData = "g_recaptcha_response: " & ", entity: " & entity & ", password: " & Password
 
    'Подсмотрел в Request Payload но не могу написать запрос, что бы авторизоваться
    '"{"g_recaptcha_response": "", "entity": "******", "password": "******"}"
 
    With oHttp
       .Open "post", URL_autorization, False
       .Send PostData
    End With
     
    'После авторизации переходим на страницу с товаром и копируем код страницы в переменную
     
    oHttp.Open "GET", URL, False
    oHttp.Send
    htmlcode = oHttp.ResponseText
    Set oHttp = Nothing
     
    'Ищем на странице информацию об остатке товара, если авторизация прошла, то будет количество,
    'если нет то будет надпись "На складе достаточно"
 
    ссылкаНачало = InStr(1, htmlcode, "На складе")
    ссылкаКонец = InStr(ссылкаНачало, htmlcode, "<")
    outstr = Mid(htmlcode, ссылкаНачало, ссылкаКонец - ссылкаНачало)
    Cells(1, 1) = outstr
  
End Sub

Прикрепленные файлы

Запрос.xlsm (15.94 КБ)

Изменено: lextoys - 16.04.2023 01:57:30

Игорь

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

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

16.04.2023 00:44:25

Чтобы работало, начало макроса должно быть таким:
(подставьте верные логин и пароль)

Код

    Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    Set objRegExp = CreateObject("VBScript.RegExp")
    Url = "https://www.sima-land.ru/4794023/nabor-dlya-sortirovki-sorter-bomboshki/"
     
    entity = "ваш email"
    Password = "ваш пароль"
    
    authURL$ = "https://www.sima-land.ru/api/v3/login-form/"
    PostData = "{""entity"":""" & entity & """,""password"":""" & Password & """}"
    With oHttp
       .Open "POST", authURL$, False
       .SetRequestHeader "Content-Type", "application/json"
       .Send PostData
       If Not .responseText Like "*rememberMe*" Then
            MsgBox .responseText, vbCritical, "Ошибка авторизации": Exit Sub
       End If
    End With
 
    MsgBox "Авторизация прошла успешно", vbInformation

Результат в ячейке: На складе 35590 наборов

Изменено: Игорь - 16.04.2023 00:53:37

Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

lextoys Пользователь Сообщений: 53 Регистрация: 03.02.2017	#3 16.04.2023 00:56:19 Спасибо огромное, буду изучать эту тему дальше!

Читают тему