在IE中执行弹出按钮后，VBA停止运行

Question

我创建了打开网站的VBA代码，然后单击上传按钮，但在执行上传按钮后，它仍在运行相同的行，但它应该运行我的API程序的下一行以填写弹出上传表单，但它没有运行。

以下是我的 VBA 代码：

IE.Navigate "https://XXX.my.XXXX.com/home/home.jsp"
Set filee = mydoc.getElementById("file")
filee.Click 'here only paused
call uploadAPI

我的 API 上传程序：

Public Declare PtrSafe Function SendMessageByString Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias _
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Dim strBuff As String, ButCap As String
Public Const WM_SETTEXT = &HC
Public Const BM_CLICK = &HF5
Sub uploadAPI()
    hw = FindWindow(vbNullString, "Choose File to Upload")
    op = FindWindowEx(hw, 0&, "Button", vbNullString)
    strBuff = String(GetWindowTextLength(op) + 1, Chr$(0))
    GetWindowText op, strBuff, Len(strBuff)
    ButCap = strBuff
    Do While op <> 0
        If InStr(1, ButCap, "Open") Then
            OpenRet = op
            Exit Do
        End If
    Loop
    hw1 = FindWindowEx(hw, 0&, "ComboBoxEx32", vbNullString)
    hw2 = FindWindowEx(hw1, 0&, "ComboBox", vbNullString)
    hw3 = FindWindowEx(hw2, 0&, "Edit", vbNullString)
    Call SendMessageByString(hw3, WM_SETTEXT, 0, _
                             "C:UserskkDocumentskaH2015MAY410.pdf")
    Call SendMessage(OpenRet, BM_CLICK, 0, 0)
End Sub

我也试过这样的

filee.Click : call uploadAPI

请建议我在单击上传弹出链接后运行我的上传 API 程序。

Answer 1

我通过运行外部 VBScript 解决了这个问题，其中包含文件路径以使用 SendKeys 方法将其设置为"选择要上传的文件"弹出窗口，然后我发送 Enter 键关闭此弹出窗口，并且运行成功，因为外部 VBScript 将在另一个线程上运行，因此它不会卡在 VBA 代码上。

笔记：1-我从VBA代码动态创建外部VBScript并将其保存在Temp文件夹中，然后我使用WScript.Shell.Run运行此脚本以在另一个线程上执行它1-在外部VBScript开始时，我设置了1秒的延迟，以确保"选择要上传的文件"弹出窗口已从VBA打开。

这是完整的代码：

....
....
IE.Navigate "https://XXX.my.XXXX.com/home/home.jsp"
Set filee = mydoc.getElementById("file")
    CompleteUploadThread MyFilePath
    filee.Foucs
    filee.Click
....
....
Private Sub CompleteUploadThread(ByVal fName As String)
    Dim strScript As String, sFileName As String, wsh As Object
    Set wsh = VBA.CreateObject("WScript.Shell")
    '---Create VBscript String---
    strScript = "WScript.Sleep 1000" & vbCrLf & _
                "Dim wsh" & vbCrLf & _
                "Set wsh = CreateObject(""WScript.Shell"")" & vbCrLf & _
                "wsh.SendKeys """ & fName & """" & vbCrLf & _
                "wsh.SendKeys ""{ENTER}""" & vbCrLf & _
                "Set wsh = Nothing"
    '---Save the VBscript String to file---
    sFileName = wsh.ExpandEnvironmentStrings("%Temp%") & "zz_automation.vbs"
    Open sFileName For Output As #1
    Print #1, strScript
    Close #1
    '---Execute the VBscript file asynchronously---
    wsh.Run """" & sFileName & """"
    Set wsh = Nothing
End Sub