Question

我有下面的代码，该代码可以执行所需的操作，但是在单击浏览按钮HTMLdoc.forms("upload").Item("fileobj").Click后，它卡在了代码行中，它没有进一步移动。请告知？

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessageByString Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Declare Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdSHow As Long) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal lngHWnd As Long) As Long
Private Declare Function EnableWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetFocus Lib "user32.dll" () As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Const WM_CLOSE As Long = &H10
Private Const SW_SHOW As Integer = 5
Private Const WM_SETTEXT As Long = &HC
Private Const BM_CLICK As Long = &HF5&

Function Main(strCommandLine As String) 'is nessesary to execute on launch
    'Dim strCommandLine As String 'path passed from VBA
    'strCommandLine = "C:\Users\jk99991\Desktop\Automation\MVA\OutputFiles\BG\F3140.000" 'path passed from VBA
    'Sleep 25000 'wait to execute, can be smarter way to check if dialog is already open

    SaveAsWindow = FindWindow(vbNullString, "Choose file to Upload")

    If SaveAsWindow = 0 Then
        MsgBox "Couldn't find the SaveAsWindow" 'msg boxes are just for troubleshooting to see if right elements are found or not
    End If

    TextComboBox = FindWindowEx(SaveAsWindow, 0&, "ComboBoxEx32", vbNullString)
    If SaveAsWindow = 0 Then
        MsgBox "Couldn't find the SaveAsWindow"
        Stop
    End If

    ComboBox = FindWindowEx(TextComboBox, 0&, "ComboBox", vbNullString)
    If ComboBox = 0 Then
        MsgBox "Couldn't find the ComboBox"  
    End If

    EditComboBox = FindWindowEx(ComboBox, 0&, "Edit", vbNullString)
    If EditComboBox = 0 Then
        MsgBox "Couldn't find the EditComboBox"
    End If

    ''and wait/sleep
    Call SendMessageByString(EditComboBox, WM_SETTEXT, 0, strCommandLine) 'here goes variable from VBA "strCommandLine"
    DoEvents
    SaveButton = FindWindowEx(SaveAsWindow, 0&, "Button", "&Open")
    Call EnableWindow(SaveButton, True)
    Call SendMessage(SaveButton, BM_CLICK, 0&, ByVal 0&)

End Function

下面是VBA代码，但单击浏览按钮后卡住了。直到我手动取消窗口提示，脚本才会进一步执行。

Set HTMLdoc = IE.Document

HTMLdoc.forms("upload").Item("fileobj").Click'Stops here does not move ahead 
Application.Wait (Now() + TimeValue("00:00:04"))

Call Main(nPath)  
Set HTMLAs = HTMLdoc.getElementsByTagName("strong")

For Each HTMLa In HTMLAs
    Debug.Print HTMLa.innerText
    If InStr(1, HTMLa.innerText, "Upload") <> 0 Then
        HTMLa.Click
    End If
Next HTMLa

如何使用VBA在提示“选择上传文件”时上传文件

0 个答案: