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:\Users\kk\Documents\ka\H\2015\MAY\410.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

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

1 个答案: