Как загрузить файл по приглашению «Выберите загрузить файл» с помощью VBA - PullRequest
Новая
       39

Как загрузить файл по приглашению «Выберите загрузить файл» с помощью VBA

0 голосов
/ 29 августа 2018

У меня есть код ниже, который делает то же самое, что я хочу, но он застревает в строке кода после нажатия кнопки обзора 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
...