Ошибка VBA при запуске события «изменение» в поле ввода IE - PullRequest
Новая
       26

Ошибка VBA при запуске события «изменение» в поле ввода IE

0 голосов
/ 21 января 2020

Я пытаюсь использовать VBA для доступа к внутренней веб-странице с помощью Inte rnet Explorer, открыть окно поиска, ввести параметры поиска и запустить поиск. Мой код будет нажимать все кнопки, найти все текстовые поля и ввести параметры. Но он не распознает ни один из параметров, введенных с использованием «.value» (т. Е. ObjElement.value = «1234567»). Я написал код, основанный на том, что я прочитал на этом форуме и ряде других, но, очевидно, я все еще что-то упускаю. Когда он пытается вызвать событие «изменения», я получаю либо ошибку 438 - объект не поддерживает это свойство или метод, либо ошибку 5 - недопустимый вызов процедуры или аргумент. Ошибка зависит от того, использую ли я dispatchEvent или FireEvent и использую ли я коллекцию или элемент в коллекции в качестве объекта. Я предполагаю, что проблема заключается в моих объявлениях, но я попробовал несколько разных, и все еще получаю ошибки.

К сожалению, это доступ к внутреннему сайту, поэтому вы не сможете запустить код. Я надеюсь, что кто-то может просто взглянуть и указать мне правильное направление. 

Dim EPA As String
Dim EPANumb As Integer
Dim EPAList() As String
Dim PrjCnt As Long
Dim PrjList As String
Dim WS As Worksheet
Dim IE As InternetExplorerMedium
Dim URL As String
Dim HWNDSrc As Long
Dim objCollection As Object
Dim objElement As Object

Dim objEvent As Object
Dim oHtml As HTMLDocument
Dim HTMLtags As IHTMLElementCollection


'Pull list of project numbers and enter into array
fn = ThisWorkbook.Name
EPANumb = WorksheetFunction.CountA(Worksheets("Instructions").Range("B:B"))
EPANumb = EPANumb - 2
ReDim EPAList(EPANumb)
For PrjCnt = 0 To EPANumb
    If EPANumb > 0 Then
        EPAList(PrjCnt) = "'" & Worksheets("Instructions").Cells((PrjCnt + 2), 2).Value & "'"
    Else
        EPAList(PrjCnt) = Worksheets("Instructions").Cells((PrjCnt + 2), 2).Value
    End If
Next

PrjList = Join(EPAList, ",")

'Open IE and navigate to URL
Set IE = New InternetExplorerMedium

IE.Visible = True 'only if you want to see what is happening
URL = "http://anysite/SnakeEyes/grid.html"
IE.navigate URL
'need If statement in case user needs to do sign on.

' Statusbar let's user know website is loading
Application.StatusBar = URL & " is loading. Please wait..."

'IE ReadyState = 4 signifies the webpage has loaded (the first loop is set to avoid inadvertently skipping over the second loop)
Do While IE.Busy = True Or IE.ReadyState <> 4: DoEvents: Loop
Application.Wait (Now + TimeValue("0:00:05"))

'Webpage Loaded
Application.StatusBar = URL & " loaded"
Set oHtml = IE.document

'HWNDScr = IE.HWND
'SetForegroundWindow HWNDScr

'Open search box and reset search parameters
oHtml.getElementById("search_grid_c_top").Click
'IE.Document.getElementById("fbox_grid_c_reset").Click
Set objEvent = oHtml.createEvent("HTMLEvents")
objEvent.initEvent "change", True, False ' **** NEW ****

Set HTMLtags = oHtml.getElementsByTagName("select")
For i = 0 To HTMLtags.Length - 1
    If HTMLtags(i).className = "selectopts" Then
        If EPANumb > 0 Then
            HTMLtags(i).Value = "in"
        Else
            HTMLtags(i).Value = "eq"
        End If
'        HTMLtags.dispatchEvent objEvent ' **** NEW ****
        Exit For
    End If
Next i

Set objEvent = oHtml.createEvent("HTMLEvents")
objEvent.initEvent "change", True, False ' **** NEW ****

Set HTMLtags = oHtml.getElementsByTagName("input")
For i = 1 To HTMLtags.Length - 1
    If HTMLtags(i).ID > "jqg" And HTMLtags(i).ID < "jqh" Then
        HTMLtags(i).Focus
        HTMLtags(i).Value = PrjList
        Exit For
    End If
Next i

HTMLtags(i).dispatchEvent objEvent ' **** NEW ****
'HTMLtags(i).FireEvent objEvent ' **** NEW **** DispatchEvent gives an error 438.
'FireEvent gives an error 5 if using the (i); error 438 without it.

HTML Код

1 Ответ

0 голосов
/ 24 января 2020

Будет ли событие "change" запускать обновление для обоих без VBA в IE? Если событие «изменить» связано только с полем ввода и не будет запускать обновление для выпадающего списка без VBA, то я думаю, что оно также не будет работать с VBA. Кроме того, на что похоже событие «изменение»?

Я делаю демонстрацию, как показано ниже, и кажется, что событие "change" может быть успешно запущено, вы можете попробовать его проверить.

HTML код: 

<!DOCTYPE html>
<html>
<head>
    <meta charset="utf-8" />
    <title></title>
</head>
<body>
    <table>
        <tbody>
            <tr>
                <td class="operators">
                    <select class="selectopts">
                        <option value="eq">equal</option>
                        <option value="in">is in</option>
                        <option value="ni">is not in</option>
                    </select>
                </td>
                <td class="data">
                    <input class="input-elm" id="jqg1" role="textbox" type="text" size="10" value="'1006191'"/>
                </td>
            </tr>
        </tbody>
    </table>
    <script>
        var select = document.getElementsByClassName('selectopts')(0);
        var input = document.getElementById('jqg1');

        input.addEventListener('change', updateValue);

        function updateValue() {
            select.value = "in";
        }
    </script>
</body>
</html>

Код VBA: 

Sub LOADIE()
    Set ieA = CreateObject("InternetExplorer.Application")
    ieA.Visible = True
    ieA.navigate "http://somewebsite"
    Do Until ieA.readyState = 4
       DoEvents
    Loop

    Set doc = ieA.Document
    Set Search = doc.getElementByID("jqg1")
    Search.Value = "VBA"

    Dim event_onChange As Object
    Set event_onChange = ieA.Document.createEvent("HTMLEvents")
    event_onChange.initEvent "change", True, False
    Search.dispatchEvent event_onChange

    'ieA.Quit
    'Set ieA = Nothing
End Sub
...