задержать SAP до открытия диалогового окна

Question

Это мой код VBA:

Sub logowanie()

    UserForm1.Show

    vSAP = Shell("C:\Program Files (x86)\SAP\FrontEnd\SAPgui\saplogon.exe", vbNormalFocus)
    Call Shell("C:\Program Files (x86)\SAP\FrontEnd\SAPgui\saplogon.exe", vbNormalFocus)
    Set WSHShell = CreateObject("WScript.Shell")

    Do Until WSHShell.AppActivate("SAP Logon")
    Application.Wait Now + TimeValue("0:00:01")
    Loop
    Set SapGui = GetObject("SAPGUI")
    Set Appl = SapGui.GetScriptingEngine

    Application.Wait Now + TimeValue("0:00:01")
    Set connection = Appl.Openconnection("xxxxxxxxxx", True)

    Application.Wait Now + TimeValue("0:00:02")
    WSHShell.SendKeys UserForm1.TextBox1.Value
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys UserForm1.TextBox2.Value
    WSHShell.SendKeys "{ENTER}"
    Application.Wait Now + TimeValue("0:00:01")
    WSHShell.SendKeys "y_ecd_96000032"
    WSHShell.SendKeys "{ENTER}"
    Application.Wait Now + TimeValue("0:00:01")
    WSHShell.SendKeys "{DOWN}"
    WSHShell.SendKeys "{DOWN}"
    WSHShell.SendKeys "{DOWN}"
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "22:00:00"
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "*"
    WSHShell.SendKeys "{ENTER}"
    Application.Wait Now + TimeValue("0:00:02")
    WSHShell.SendKeys "DC15"
    Application.Wait Now + TimeValue("0:00:02")
    WSHShell.SendKeys "{ENTER}"
    Application.Wait Now + TimeValue("0:00:02")
    WSHShell.SendKeys "{DOWN}"
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "{ENTER}"
    Application.Wait Now + TimeValue("0:00:02")
    WSHShell.SendKeys "^{TAB}"
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "{ENTER}"
    Application.Wait Now + TimeValue("0:00:02")
    WSHShell.SendKeys "U:\[...]\a.txt"
    WSHShell.SendKeys "{ENTER}"
    Application.Wait Now + TimeValue("0:00:03")
    WSHShell.SendKeys "{F8}"
    Application.Wait Now + TimeValue("0:00:03")
    WSHShell.SendKeys "{F8}"
    Application.Wait Now + TimeValue("0:00:03")
    WSHShell.SendKeys "+{F4}"
    Application.Wait Now + TimeValue("0:00:02")
    WSHShell.SendKeys "U:\[...]\SRET.xlsx"
    WSHShell.SendKeys "{ENTER}"
    'Application.Wait Now + TimeValue("0:00:03")
    WSHShell.SendKeys "{LEFT}"
    WSHShell.SendKeys "{ENTER}"
    Application.Wait Now + TimeValue("0:00:04")
    AppActivate (vSAP)
    Application.Wait Now + TimeValue("0:00:02")
    WSHShell.SendKeys "%{F4}"
    Application.Wait Now + TimeValue("0:00:02")
    WSHShell.SendKeys "{TAB}"
    WSHShell.SendKeys "{ENTER}"

    End Sub

Мне нужно приложение. Подождите сейчас + [некоторое значение времени] между командами.Но иногда это не работает, когда SAP работает слишком медленно.Как это сделать?Мне нужно несколько циклов с Application.Wait, когда каждое диалоговое окно появляется.

Answer 1

Вот решение:

Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long

Public Sub IEFrameToTop()
 Dim THandle As Long

 THandle = FindWindow(vbNullString, "**** name of child window here ****")

 If THandle = 0 Then
  MsgBox "Could not find window.", vbOKOnly
 Else
  SetForegroundWindow (THandle)

  SendKeys "%{F4}"
  Application.Wait (Now + TimeValue("0:00:02"))
  SendKeys "{TAB}"
  SendKeys "{ENTER}"

 End If
End Sub

Спасибо за вашу помощь.

Answer 2

Я думаю, что самый простой способ - использовать WinAPI для проверки названия текущего окна.Попробуйте это:

Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal HWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Sub Test()
    WaitForWindow "Notepad"
    Debug.Print "Notepad is opened"
End Sub

Sub WaitForWindow(Title As String)
    Dim TopWindow As String
    Do
        DoEvents
        TopWindow = WindowTitle
        Application.Wait Now + TimeValue("0:00:01")
    Loop Until InStr(1, TopWindow, WindowTitle, vbTextCompare) > 0
End Sub

Function WindowTitle()
    Dim WinText As String
    Dim HWnd As Long
    Dim L As Long
    HWnd = GetForegroundWindow()
    WinText = String(255, vbNullChar)
    L = GetWindowText(HWnd, WinText, 255)

    WindowTitle = Left(WinText, InStr(1, WinText, vbNullChar) - 1)
End Function

Когда вы запустите метод Test, он будет ожидать чего-то с Notepad в заголовке.Вместо этого поместите заголовок диалога в вызов.