延迟SAP GUI直到对话窗口打开



我需要在命令之间使用Application.Wait Now + [some time value]。但是有时候,当SAP工作太慢时,它行不通。怎么做?当每个对话框窗口显示时,我需要使用Application.WaitLoop

这是我的VBA代码:

Sub logowanie()
    
    UserForm1.Show
    
    vSAP = Shell("C:Program Files (x86)SAPFrontEndSAPguisaplogon.exe", vbNormalFocus)
    Call Shell("C:Program Files (x86)SAPFrontEndSAPguisaplogon.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

我认为最简单的方法是使用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

运行测试方法时,它将等待标题中带有记事本的东西。将您的对话框标题放在呼叫中。

这是解决方案:

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

感谢您的帮助。

最新更新