0

我已经创建了打开网站并单击上传按钮的 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 程序。

4

1 回答 1

0

我通过运行包含文件路径的外部 VBScript 解决了这个问题，然后使用 SendKeys 方法将其设置在“选择要上传的文件”弹出窗口中，然后我发送 Enter Key 关闭此弹出窗口，并且成功运行，因为外部 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
于 2017-07-28T20:37:07.500 回答