Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Запуск макросом сторонней программы, с вводом пароля
 
#1
22.11.2021 20:00:41
Добрый день!
Пытаюсь реализовать запуск сторонней программы, с вводом пароля, из excel, я сделал так:
Код
Sub Programm()

Shell "explorer.exe c:\...*.lnk", vbNormalFocus
     Application.Wait Time:=Now + TimeValue("0:00:10")
          SendKeys "{TAB}"
          SendKeys "password"
          SendKeys "{ENTER}"
End Sub

И все работает. Но не всегда окно с вводом пароля появляется через 10 секунд, бывает раньше, бывает и позже. Как можно обойти время ожидания, и не продолжать процедуру, пока не появится окно ввода пароля, например:

AppActivate ("Регистрация")
 
 
 
#2
23.11.2021 09:08:49
В интернете есть программки для подобных действий. Ищут на экране заранее заданную картинку и выполняют действия, передвигают курсор, кликают, нажимают клавиши на клавиатуре. Программирование проще, чем VBA.
 
 
 
#3
23.11.2021 10:28:13
Мне кажется надо в бесконечном цикле искать нужное окно с помощью WinAPI Findwindow() с нужным заголовком. Как только нашли такое окно (получили указатель на него), то выход из цикла и ввод пароля
Изменено: New - 23.11.2021 10:29:13
 
 
 
#4
25.11.2021 23:29:48
Код
#If Win64 Then
  Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
  Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Sub Programm()

   Dim MyWinID, Password

   MyWinID = ("Регистрация")         'Указываем название окна
   Password = "password"                'Указываем пароль
   
'Запускаем ярлык программы

   Shell "explorer.exe C:\*.lnk", vbNormalFocus
   
'Ищем окно

   hwnd = FindWindow(vbNullString, MyWinID)

'Выполняем поиск окна пока оно не найдено

   Do While (hwnd = 0)
        hwnd = FindWindow(vbNullString, MyWinID)
        If hwnd <> 0 Then
        Exit Do
        End If
   Loop

'Активируем найденное окно и вводим пароль, при условии что логин уже введен

        Application.Wait Time:=Now + TimeValue("0:00:02")
        AppActivate MyWinID
        SendKeys "{TAB}"                  
        SendKeys Password
        SendKeys "{ENTER}"
       
End Sub

Решил вот таким способом! Может кому пригодится
 
 
 
#5
25.11.2021 23:31:21
а ты молодец! Только я бы добавил защиту от бесконечного цикла, а то программа не откроется, либо заголовок окна будет другим - и программа зависнет в бесконечном цикле. Предлагаю такой вариант

Код
#If Win64 Then
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
 
Sub StarProgramAndInputPassword()
    Dim Hwnd As LongPtr, MyWinID As String, Password As String, ProgramPath As String, ExitTime As Double
       
    'путь к программе
    ProgramPath = "C:\Program Files\Microsoft Office\root\Office16\WINWORD.EXE"
    'Указываем заголовок окна программы
    MyWinID = ("Документ1 - Word")
    'Указываем пароль
    Password = ".password"
    
    'Запускаем программу
    Shell ProgramPath, 1 '1 = vbNormalFocus
    'Shell "explorer.exe C:\*.lnk", 1 '1 = vbNormalFocus
    'Ищем handler окна программы
    Hwnd = FindWindow(vbNullString, MyWinID)
    'защита от бесконечного цикла 20 секунд
    ExitTime = Now + TimeValue("0:00:20")
    'Выполняем поиск окна пока оно не найдено
    Do While (Hwnd = 0)
        Hwnd = FindWindow(vbNullString, MyWinID)
        If Hwnd <> 0 Then Exit Do
        If Now >= ExitTime Then Exit Sub
    Loop
    'Активируем найденное окно и вводим пароль, при условии что логин уже введен
    Application.Wait Time:=Now + TimeValue("0:00:01")
    On Error Resume Next
    AppActivate MyWinID
    On Error GoTo 0
    If Err <> 0 Then
        Err.Clear
        Exit Sub
    End If
    SendKeys "{TAB}"
    SendKeys Password
    SendKeys "{ENTER}"
End Sub
Изменено: New - 26.11.2021 00:15:28
 
 
 
Страницы: 1
Наверх