Авторизация на веб-сервере средствами VBA

Подскажите, в каком направлении двигаться для реализации авторизации через VBA....
PS Сайт написан на VBA.

Я использовал код из вашей функции "Function ConnectServer() As Object"
в 2021г он прекрасно работал. Затем перестал.
При запуске макроса загружается MS Edge и Internet Explorer
MS Edge загружает указанную в макросе страницу
Internet Explorer возвращает сообщение:
"Этот веб-сайт не работает в Internet Explorer
Веб-сайт, который вы пытаетесь открыть, не работает в Internet Explorer, поэтому вы были перенаправлены в Microsoft Edge.
Поддержка Internet Explorer 11 прекратилась 15 июня 2022 г."
VBA возвращает сообщение об ошибке в строке " Set oIE = oIE.Document: DoEvents: DoEvents"
Буду признателен, если вы скорректируете код функции "Function ConnectServer() As Object" с учетом текущих реалий.
Спасибо

После обновления WIN10 ваше решение перестало работать....
Предполагаю, это связано из-за "выпиливания" IE.
Осталась возможность авторизации на веб-сервере средствами VBA?
Если да, тогда как решить проблему
Спасибо

Подскажите, какие библиотеки надо подключать, все эти вещи компилятор не пропускает SetSelectElementValue, SetSelectElementValue IEdoc, SetInputElementValue IEdoc

Здравствуйте! подскажите можно ли исправить этот код для работы на macOS?

СПАСИБО!!!! И за пример и за оперативность! Я вам очень благодарна!

Спасибо, за ответ! Буду с нетерпением ждать, надеюсь всё таки способ найду, с авторизацией же разобралась. Решение уже близко, по крайней мере, хочется в это верить.

Добрый день спасибо за ваши подсказки, благодаря вашей статье и ещё на одном сайте, настроила авторизацию на сайт, переходы по ссылкам работают, да вот беда когда начинаешь закачивать файлы по средством:
Function DownloadFile(FromPathName, ToPathName) As Boolean
DownloadFile = URLDownloadToFile(0, FromPathName, ToPathName, 0, 0) = 0
End Function

URL$ = ""
FileName$ = ""
IE.Navigate URL$
Set ieDoc = IE.Document: DoEvents: DoEvents
DownloadFile URL$, FileName$.
Качается файл с содержимым окна о не пройденной авторизации, может подскажете как обойти это? Может есть ещё какой то метод?

Прошу помощи у Гуру. Не могу понять, где ошибка закралась. Целиком и пошагово скрипт отрабатывает без ошибок, в Excel'е создается подключение и диапазон, в который почему-то переносится только 2 пустые ячейки. Предыстория: есть портал, необходимо на нем авторизоваться и затем по некоторому адресу забрать в Excel табличку с некоторым id. Вот код:

 
Public Const URL_Login = "http://aaa.com/" ' страница входа
Public Const URL_LoginOK = "http://aaa.com/Supplier" ' сюда попадем, если вход удался
Public Const URL_main = "http://aaa.com/Supplier" ' а эта страница сайта нам нужна для работы
Sub GetForfeits_ConnectServer()
 
 On Error Resume Next
 Set IE = ConnectServer ' авторизуемся на портале
 Set IEdoc = IE.Document ' получаем ссылку на документ
 
 'Выполняем добавление запроса таблички "markup" по адресу aaa.com/Supplier
 With ActiveSheet.QueryTables.Add(Connection:= _
 "URL;http://aaa.com/Supplier", Destination:=Range("$A$2"  ;)  )
 .Name = "Supplier"
 .FieldNames = True
 .RowNumbers = False
 .FillAdjacentFormulas = False
 .PreserveFormatting = True
 .RefreshOnFileOpen = False
 .BackgroundQuery = True
 .RefreshStyle = xlOverwriteCells
 .SavePassword = False
 .SaveData = True
 .AdjustColumnWidth = True
 .RefreshPeriod = 0
 .WebSelectionType = xlSpecifiedTables
 .WebFormatting = xlWebFormattingNone
 .WebTables = """markup"""
 .WebPreFormattedTextToColumns = True
 .WebConsecutiveDelimitersAsOne = True
 .WebSingleBlockTextImport = False
 .WebDisableDateRecognition = False
 .WebDisableRedirections = False
 .Refresh BackgroundQuery:=False
 End With
 IE.Quit ' закрываем браузер
End Sub
 
Function ConnectServer() As Object
 
 
 Login$ = "xxxx": Password$ = "yyyy" ' укажите здесь логин и пароль для сайта
 On Error Resume Next: Err.Clear
 Set IE = CreateObject("InternetExplorer.Application"  ;)  
 IE.Visible = True ' для тестирования
 
 
 IE.Navigate URL_Login
 While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend
 
 Set IEdoc = IE.Document: DoEvents: DoEvents
 
 ' заполняем поля с логином и паролем
 IEdoc.getElementsByName("login"  ;)  .Item(0).Value = Login$
 IEdoc.getElementsByName("password"  ;)  .Item(0).Value = Password$
 ' и жмем на кнопку "Войти"
 IEdoc.getElementsByName("btn-submit"  ;)  .Item(0).Click
 
 If Err Then MsgBox "Не удаётся загрузить страницу", vbCritical: End
 While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend
 
 If IE.LocationURL <> URL_LoginOK Then
 MsgBox "Логин или пароль неверны!", vbCritical, "Ошибка авторизации": Pi.Hide: End
 End If
 
 IE.Navigate URL_main
 While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend
 
 Set ConnectServer = IE
 ' pi.Hide
End Function

попробовал использовать этот код для своих целей, поля авторизации заполняет правильно, а вот нажать на кнопку не получается.
Помогите, как из VBA нажать на кнопку "войти" на сайте:
www_heroeswm_ru

у меня почему то не работает команда submit. тоесть все данные вбиваются но приходиться нажимать вручную!

Public Const URL_Login = "https://www.atsenergo.ru/auth" ' ñòðàíèöà âõîäà
Public Const URL_LoginOK = "https://www.atsenergo.ru/reporting/personal/" ' ñþäà ïîïàäåì, åñëè âõîä óäàëñÿ
Public Const URL_main = "https://www.atsenergo.ru/reporting/personal/eur/sell_norem/20130922" ' à ýòà ñòðàíèöà ñàéòà íàì íóæíà äëÿ ðàáîòû

Sub ÏðèìåðÈñïîëüçîâàíèÿ_ConnectServer()
' Dim IE As SHDocVw.InternetExplorer, IEdoc As HTMLDocument
On Error Resume Next
Set IE = ConnectServer ' àâòîðèçóåìñÿ íà ñåðâåðå

Set IEdoc = IE.Document ' ïîëó÷àåì ññûëêó íà äîêóìåíò

IE.Quit ' çàêðûâàåì áðàóçåð
End Sub

Function ConnectServer() As Object
' ôóíêöèÿ ïðåäíàçíà÷åíà äëÿ àâòîðèçàöèè íà ñàéòàõ
' (ââîä ëîãèíà è ïàðîëÿ ÷åðåç âåá-èíòåðôåéñ)
' Âîçâðàùàåò îáúåêò òèïà InternetExplorer ñ çàãðóæåííîé ñòðàíèöåé ñàéòà, ãäå ìû àâòîðèçîâàëèñü
' ÍÅÍÓÆÍÛÅ ÑÒÐÎÊÈ ÊÎÄÀ ÇÀÊÎÌÌÅÍÒÈÐÎÂÀÍÛ

Login$ = "лялялял": Password$ = "ляляля " ' óêàæèòå çäåñü ëîãèí è ïàðîëü äëÿ ñàéòà
On Error Resume Next: Err.Clear
' Dim pi As New ProgressIndicator
' pi.Show "Îòïðàâêà îáúÿâëåíèé íà ñàéò ðèýëòîðñêîãî àãåíñòâà..."
Pi.StartNewAction 5, 10, "Óñòàíîâêà ñîåäèíåíèÿ ñ ñåðâåðîì ..."
Set IE = CreateObject("InternetExplorer.Application")
' IE.Visible = True ' äëÿ òåñòèðîâàíèÿ
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True ' äëÿ òåñòèðîâàíèÿ
IE.Silent = True 'ïîäàâëåíèå âñïëûâàþùèõ îêîí Explorer

' pi.StartNewAction 10, 50, "Çàãðóçêà ñòðàíèöû àâòîðèçàöèè ...", , , 10
IE.Navigate URL_Login
' æä¸ì, ïîêà ñòðàíèöà çàãðóçèòüñÿ
' t = Timer: While IE.Busy Or (IE.ReadyState <> 4)
' DoEvents: If Timer - t > 0.1 Then pi.SubAction: t = Timer
' Wend: DoEvents
While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend

' pi.StartNewAction 50, 80, "Àâòîðèçàöèÿ íà ñåðâåðå...", , , 15

Set IEdoc = IE.Document: DoEvents: DoEvents

' çàïîëíÿåì ïîëÿ ñ ëîãèíîì è ïàðîëåì
IEdoc.getElementsByName("j_usercode").Item(0).Value = Login$
IEdoc.getElementsByName("j_username").Item(0).Value = Login$
IEdoc.getElementsByName("j_password").Item(0).Value = Password$
' è îòïðàâëÿåì äàííûå ôîðìû íà ñåðâåð

IEdoc.getElementsByName("action").Item(0).submit
IE.Visible = True ' äëÿ òåñòèðîâàíèÿ
IE.Silent = True 'ïîäàâëåíèå âñïëûâàþùèõ îêîí Explorer

If Err Then MsgBox "Íå óäà¸òñÿ çàãðóçèòü ñòðàíèöó", vbCritical: End
' æä¸ì, ïîêà ñòðàíèöà çàãðóçèòüñÿ
' t = Timer: While IE.Busy Or (IE.ReadyState <> 4)
' DoEvents: If Timer - t > 0.1 Then pi.SubAction: t = Timer
' Wend
While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend

If IE.LocationURL <> URL_LoginOK Then
MsgBox "Ëîãèí èëè ïàðîëü íåâåðíû!", vbCritical, "Îøèáêà àâòîðèçàöèè": Pi.Hide: End
End If

' pi.StartNewAction 80, 100, "Çàãðóçêà ñòðàíèöû îòïðàâêè îáúÿâëåíèé ...", , , 10
IE.Navigate URL_main
' æä¸ì, ïîêà ñòðàíèöà çàãðóçèòüñÿ
' t = Timer: While IE.Busy Or (IE.ReadyState <> 4)
' DoEvents: If Timer - t > 0.1 Then pi.SubAction: t = Timer
' Wend
While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend

Set ConnectServer = IE
' pi.Hide
End Function

Нашел, вопрос решается с помощью кода после создания объекта IE:

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True ' для тестирования
IE.Silent = True 'подавление всплывающих окон Explorer

По завершения работы процедуры регистрации, выходит стандартное окно: "открыть или сохранить этот файл?" Где-то в интернете видел что это стандартное окно блокнота, как согласиться на сохранение файла?

В какой книге можно подробнее почитать о получении/передаче информации в интернете?

При обработки этого кода выходит сообщение "Отображать только безопасное содержимое веб-старниц?". Как с ним бороться если нет возможности отключить это всплывающее окно в IExplorer?

Помоги пожалуйста! Что я сделал не так?

Public Const URL_Login = "https://br.so-ups.ru/Public/Login.aspx?ReturnUrl=%2fEntityDataView%2fGtp.aspx#"    ' страница входа
Public Const URL_LoginOK = "https://br.so-ups.ru/EntityDataView/Gtp.aspx"    ' сюда попадем, если вход удался
Public Const URL_main = "https://br.so-ups.ru/Export/Csv/Gtp.aspx?&date=24.01.2012&gtpIds=GIRKEN08"    ' а эта страница сайта нам нужна для работы

Sub ПримерИспользования_ConnectServer()
    ' Dim IE As SHDocVw.InternetExplorer, IEdoc As HTMLDocument
   On Error Resume Next
    Set IE = ConnectServer    ' авторизуемся на сервере

    Set IEdoc = IE.Document    ' получаем ссылку на документ

    ' заполняем поля на сайте
    SetSelectElementValue IEdoc, "login", Логин
    SetSelectElementValue IEdoc, "password", Пароль
   'SetInputElementValue IEdoc, "body", Comment

    ' отправляем данные на сервер
   IEdoc.getElementsByName("add_form").Item(0).submit
 
    IE.Quit ' закрываем браузер
End Sub
 
Function ConnectServer() As Object
    ' функция предназначена для авторизации на сайтах
   ' (ввод логина и пароля через веб-интерфейс)
   ' Возвращает объект типа InternetExplorer с загруженной страницей сайта, где мы авторизовались
   ' НЕНУЖНЫЕ СТРОКИ КОДА ЗАКОММЕНТИРОВАНЫ

    Login$ = "...": Password$ = "..."    ' укажите здесь логин и пароль для сайта
   On Error Resume Next: Err.Clear
    ' Dim pi As New ProgressIndicator
   ' pi.Show "Отправка объявлений на сайт риэлторского агенства..."
   ' pi.StartNewAction 5, 10, "Установка соединения с сервером ..."
   Set IE = CreateObject("InternetExplorer.Application")
    ' IE.Visible = True ' для тестирования
   
    ' pi.StartNewAction 10, 50, "Загрузка страницы авторизации ...", , , 10
   IE.Navigate URL_Login
    ' ждём, пока страница загрузиться
   '    t = Timer: While IE.Busy Or (IE.ReadyState <> 4)
   '        DoEvents: If Timer - t > 0.1 Then pi.SubAction: t = Timer
   '    Wend: DoEvents
   While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend
 
    ' pi.StartNewAction 50, 80, "Авторизация на сервере...", , , 15
   
    Set IEdoc = IE.Document: DoEvents: DoEvents
 
    ' заполняем поля с логином и паролем
   IEdoc.getElementsByName("login_r").Item(0).Value = Login$
    IEdoc.getElementsByName("passwd_r").Item(0).Value = Password$
    ' и отправляем данные формы на сервер
   IEdoc.getElementsByName("login_form").Item(0).submit
 
    If Err Then MsgBox "Не удаётся загрузить страницу", vbCritical: End
    ' ждём, пока страница загрузиться
   '    t = Timer: While IE.Busy Or (IE.ReadyState <> 4)
   '        DoEvents: If Timer - t > 0.1 Then pi.SubAction: t = Timer
   '    Wend
   While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend
 
    If IE.LocationURL <> URL_LoginOK Then
        MsgBox "Логин или пароль неверны!", vbCritical, "Ошибка авторизации": pi.Hide: End
    End If