Форма входа

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
    ByVal dx As Long, ByVal dy As Long, _
    ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Sub Command2_Click()
' Перемещаем указатель мыши
mouse_event &H1, 100, 100, 0, 0
' Нажимаем и отпускаем левую кнопку
mouse_event &H2, 0, 0, 0, 0
mouse_event &H4, 0, 0, 0, 0
End Sub

mouse_event &H1, 100, 100, 0, 0

Option Explicit
 
Sub IE_Internet_Explorer()
 
'https://www.cyberforum.ru/vba/thread328405-page7.html
'Web браузер показывает страницу на основе HTML текста, то есть в страничке есть теги:
'<a> </a> - ссылки
'<table></table> - таблицы
 
'отключаем обновление - дёргание экрана при выполнении кода
    Application.ScreenUpdating = False
 
    Dim objCollectionIf As Object
    Dim Shell As Object
    Dim Wins As Object
    Dim WinItem As Variant
    Dim oDoc As Object
    Dim InputName As String
    Const SiteURL As String = "http://www.yandex.ru/"
    Dim WinItemLocationURL As String
    Dim FullWinItemLocationURL As String
    Dim objCollectionIfName As String
    Dim objCollectionIfValue As String
    Dim Все_ссылки As String
    Dim Все_кнопки_поля_чекбоксы As String
 
    Dim objCollectionIfLength_input As Integer
    Dim objCollectionIfLength_a As Integer
    Dim objCollectionIfType As String
    Dim i As Integer
    Dim WinItemLocationURLCount As Integer
    Dim Ссылки As Integer
    Dim Кнопки_поля_чекбоксы As Integer
 
    Dim Страница_IE_найдена As Boolean
 
    Set Shell = CreateObject("shell.application")
 
    For Each WinItem In Shell.Windows
 
        WinItemLocationURL = WinItem.LocationURL
        If Mid$(WinItemLocationURL, 1, 7) <> "file://" Then
            WinItemLocationURLCount = WinItemLocationURLCount + 1
            FullWinItemLocationURL = FullWinItemLocationURL & WinItemLoca-tionURLCount & ": " & WinItemLocationURL & Chr$(13)
 
            If WinItem.LocationURL = SiteURL Then
                Set oDoc = WinItem.Document
                Страница_IE_найдена = True
            Else
            End If
        End If
    Next
 
    If Страница_IE_найдена = True Then
        MsgBox$ _
                "Найдено вкладок Internet Explorer: " & WinItemLocation-URLCount & Chr$(13) & _
                                                      FullWinItemLocationURL, vbOKOnly, _
                                                      "Внимание"
    Else
        MsgBox$ _
                "Не найдена требуемая страница: " & SiteURL & Chr$(13) & _
                                                  "Программа не может быть продолжена" & Chr$(13) & _
                                                  "Найдено вкладок Internet Explorer: " & WinItemLocationURLCount & Chr$(13) & _
                                                  FullWinItemLocationURL, vbOKOnly, _
                                                  "Внимание"
        GoTo Конец
    End If
 
    'Когда пишем oDoc.getElementsByTagName("input")
    'то получаем по тегам всю коллекцию ("input")
    'полей, у полей Name = "text", Type = "text"
    'кнопок, у кнопки Name = "Имя кнопки", Type = "submit"
    'чекбоксов, у чекбокса Name = "twoweeks", Type = "checkbox"
 
    Set objCollectionIf = oDoc.getElementsByTagName("input")
    objCollectionIfLength_input = objCollectionIf.Length
    'проходит по всем кнопкам, полям, чекбоксам - ("input")
    While i < objCollectionIf.Length
        objCollectionIfType = objCollectionIf(i).Type
        objCollectionIfName = objCollectionIf(i).Name
        objCollectionIfValue = objCollectionIf(i).Value
 
        Кнопки_поля_чекбоксы = Кнопки_поля_чекбоксы + 1
        Все_кнопки_поля_чекбоксы = Все_кнопки_поля_чекбоксы & _
                                   Кнопки_поля_чекбоксы & ":" & " Type: " & objCollectionIf(i).Type & " Name: " & objCollectionIf(i).Name & " Value: " & objCollectionIf(i).Value & Chr$(13)
 
        'вводим в поле требуемый текст
        If objCollectionIf(i).Name = "text" Then
            objCollectionIf(i).Value = "Нужный текст"
            'GoTo Текст_в_поле_ввели
        End If
        i = i + 1
    Wend
    i = 0
 
    MsgBox$ _
            "Кнопки, поля, чекбоксы: " & Кнопки_поля_чекбоксы & Chr$(13) & _
                                       Все_кнопки_поля_чекбоксы, vbOKOnly, _
                                       "Внимание"
 
Текст_в_поле_ввели:
 
    Set objCollectionIf = oDoc.getElementsByTagName("input")
    objCollectionIfLength_input = objCollectionIf.Length
    'проходит по всем кнопкам, полям, чекбоксам - ("input")
    While i < objCollectionIf.Length
        objCollectionIfType = objCollectionIf(i).Type
        objCollectionIfName = objCollectionIf(i).Name
        objCollectionIfValue = objCollectionIf(i).Value
        'ищем инпут с типом субмит(кнопку)
        If (objCollectionIf(i).Value = "Найти" And objCollectionIf(i).Type = "submit") Then
            'нажимаем кнопку
            objCollectionIf(i).Click
            'выходим из цикла
            GoTo Кнопку_нажали
        End If
        i = i + 1
    Wend
    i = 0
 
Кнопку_нажали:
 
    Set objCollectionIf = oDoc.getElementsByTagName("input")
    objCollectionIfLength_input = objCollectionIf.Length
    'проходит по всем кнопкам, полям, чекбоксам - ("input")
    While i < objCollectionIf.Length
        objCollectionIfType = objCollectionIf(i).Type
        objCollectionIfName = objCollectionIf(i).Name
        objCollectionIfValue = objCollectionIf(i).Value
        If objCollectionIf(i).Type = "checkbox" And objCollectionIf(i).Name = "twoweeks" Then
            'отмечаем checkbox ...
            objCollectionIf(i).Checked = True
            'уточняем состояние checkbox, ставим или снимаем его
            If objCollectionIf(i).Checked = True Then
                objCollectionIf(i).Checked = False
            ElseIf objCollectionIf(i).Checked = False Then
                objCollectionIf(i).Checked = True
            End If
        End If
        i = i + 1
    Wend
    i = 0
 
    'Когда пишем oDoc.getElementsByTagName("а")
    'тогда получаем по тегам всю коллекцию ссылок, то есть буква ("а") - это название тега
    Set objCollectionIf = oDoc.getElementsByTagName("a")
    objCollectionIfLength_a = objCollectionIf.Length
    'проходит по всем ссылкам - ("а")
    While i < objCollectionIf.Length
        objCollectionIfType = objCollectionIf(i).Type
        objCollectionIfName = objCollectionIf(i).Name
        objCollectionIfValue = objCollectionIf(i).Value
        If Len((objCollectionIf(i).Title)) <> 0 Then
            Ссылки = Ссылки + 1
            Все_ссылки = Все_ссылки & Ссылки & ": " & objCollec-tionIf(i).Title & Chr$(13)
            'MsgBox$ (objCollectionIf(i).Title)
            If objCollectionIf(i).Title = "Уточнить сведения" Then
                'вызываем событие клика у полученного элемента
                objCollectionIf(i).onclick
            End If
        End If
        i = i + 1
    Wend
 
    MsgBox$ _
          i & Chr$(13) & _
            "Ссылки: " & Ссылки & Chr$(13) & _
            Все_ссылки, vbOKOnly, _
            "Внимание"
 
    Selection.TypeText Text:=i & Chr$(13) & _
                             "Ссылки: " & Ссылки & Chr$(13) & _
                             Все_ссылки
    i = 0
 
    'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
    Set objCollectionIf = Nothing
    Set oDoc = Nothing
 
Конец:
 
    Set Shell = Nothing
 
    'отменяем отключенное ранее обновление - дёргание экрана при выполнении кода
    Application.ScreenUpdating = True
 
End Sub

Private Sub Command1_Click()
 
 
WebBrowser1.Silent = True
    WebBrowser1.Navigate "http://************.com"
  
   Do While WebBrowser1.Busy
        DoEvents
Loop
WebBrowser1.Document.All("login").Value = Text1.Text
 WebBrowser1.Document.All("password").Value = Text2.Text
 
End Sub

Sub Открыть_************_com_ввод_логина_пароля()
 
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
 
    IE.navigate "http://************.com"
 
    Do While IE.Busy
        DoEvents
    Loop
 
    IE.Document.all("login").Value = "Text1Text"
    IE.Document.all("password").Value = "Text2Text"
 
    'открывает, делает видимым InternetExplorer
    IE.Visible = True
    
    'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
    Set IE = Nothing
 
End Sub