Excel VBA Internet Explorer FireEvent «Onchange» не работает при выборе из выпадающего в IE

Question

Я создаю простой макрос для получения номеров факсов с публичного банковского сайта.Я написал достаточно кода (код ниже), чтобы иметь возможность попасть на сайт, выбрать из выпадающего списка и даже изменить выбор в выпадающем списке.Однако, когда я использую FireEvent ("onChange"), он не запускает обновление веб-страницы.

Я искал и искал ответ, но не нашел ни одного.

Веб-сайт: https://www.atb.com/contact-us/Pages/branch-locator.aspx

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Sub test()

    Dim ieExplorer As New InternetExplorerMedium
    Dim ieField As Object
    Dim ieSubmit As Object
    Dim ieSelect As Object
    Dim iebutton As Object
    Dim buttCounter As Integer
    Dim objOption As Object
    Dim objCount As Integer
    Dim ieForm As Object

    Dim intRow As Long, faxNum As String

    intRow = 2

    With ieExplorer
        .Visible = True
        .Navigate "https://www.atb.com/contact-us/Pages/branch-locator.aspx"
        Sleep 1000
        Sleep 1000
        Sleep 1000
        Sleep 1000
        Sleep 1000
        Sleep 1000
        Sleep 1000

            Set ieSelect = .Document.getElementsByTagName("select")

            Do While o < ieSelect.Length

                If ieSelect(o).ID = "ba" Then

                    For Each i In ieSelect(o).Options

                        If i.Value <> "null" Then

                            ieSelect(o).Focus
                            i.Selected = True
                            ieSelect(o).FireEvent "onchange"

                            Set ieField = .Document.getElementsByTagName("p")

                            Do While x < ieField.Length

                                If InStr(ieField(x).innertext, "FAX") Then

                                    Cells(intRow, "A").Value = i.Value
                                    Cells(intRow, "B").Value = ieField(x).innertext
                                    intRow = intRow + 1

                                End If

                            Loop

                        End If


                    Next

                End If

                o = o + 1
            Loop

     End With

End Sub

Answer 1

Я бы использовал POST-запрос XMLHTTP / WinHttp, взял xml и затем проанализировал его.Вы можете адаптировать как функцию.Я бы предпочел взять все номера факсов за один раз и написать на листе.Я использую xpath для получения заголовка (название филиала) и номеров факсов.

---

Вы можете адаптировать синтаксис xpath для получения любого из перечисленных значений.Например, возвращается строка, из которой можно выбрать значения:

<z:row ows_ID='1' ows_Title='Acadia Valley' ows_Transit='1.00000000000000' ows_Classification='Agency' ows_Address='Acadia Valley' ows_City='Acadia Valley' ows_Postal='T0J 0A0' ows_Phone='(403) 972-3805' ows_Fax='(403) 972-2263' ows_Hours='Mon-Fri 9:00-12:30, 13:30-16:00' ows_LAT='51.159888' ows_LONG='-110.209308' ows__ModerationStatus='0' ows__Level='1' ows_UniqueId='1;#{2973F9AC-2019-4BD1-A740-41A270BAC267}' ows_owshiddenversion='3' ows_FSObjType='1;#0' ows_Created='2015-11-18 13:58:48' ows_PermMask='0x1000030041' ows_Modified='2016-02-08 11:16:05' ows_FileRef='1;#Lists/Branches/1_.000' ows_MetaInfo='1;#' />

---

VBA:

Option Explicit
Public Sub GetFaxNumbers()
    Dim body As String, xmlDoc As Object, request As Object

    Application.ScreenUpdating = False
    Set xmlDoc = CreateObject("MSXML2.DOMDocument") 'New MSXML2.DOMDocument60

    body = "<soapenv:Envelope xmlns:soapenv='http://schemas.xmlsoap.org/soap/envelope/' xmlns:soap='http://schemas.microsoft.com/sharepoint/soap/'>"
    body = body & "<soapenv:Body><GetListItems xmlns='http://schemas.microsoft.com/sharepoint/soap/'><listName>Branches</listName>"
    body = body & "<viewFields><ViewFields><FieldRef Name='ID' /><FieldRef Name='Title' /><FieldRef Name='Transit' />"
    body = body & "<FieldRef Name='Classification' /><FieldRef Name='Address' /><FieldRef Name='City' /><FieldRef Name='Postal' />"
    body = body & "<FieldRef Name='Phone' /><FieldRef Name='Fax' /><FieldRef Name='Hours' /><FieldRef Name='LAT' /><FieldRef Name='LONG' />"
    body = body & "</ViewFields></viewFields><rowLimit>0</rowLimit><query><Query><OrderBy><FieldRef Name='Title' Ascending='True' />"
    body = body & "</OrderBy></Query></query></GetListItems></soapenv:Body></soapenv:Envelope>"

    Set request = CreateObject("WinHttp.WinHttpRequest.5.1")
    With request
        .Open "POST", "https://www.atb.com/_vti_bin/lists.asmx", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.3; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/66.0.3359.181 Safari/537.36"
        .setRequestHeader "Content-Type", "text/xml"
        .send body
        With xmlDoc
            .validateOnParse = True
            .setProperty "SelectionLanguage", "XPath"
            .async = False
            If Not .LoadXML(request.responseText) Then
                Err.Raise .parseError.ErrorCode, , .parseError.reason
            End If
        End With
    End With

    Dim elements As Object, counter As Long, rowNum As Long
    Set elements = xmlDoc.SelectNodes("//@ows_Title | //@ows_Fax")
    rowNum = 1
    For counter = 0 To elements.Length - 1 Step 2
        With ThisWorkbook.Worksheets("Sheet1")
            .Cells(rowNum, 1) = elements(counter).Text
            .Cells(rowNum, 2) = elements(counter + 1).Text
        End With
        rowNum = rowNum + 1
    Next
    Application.ScreenUpdating = True
End Sub

---

Пример результатов:

Answer 2

Похоже, что изменение выбора установлено с помощью этого кода:

 $('body').find('#ba').change(function(){
        var a = $(this).val();
        lookyloo(a);
    });

Вы должны быть в состоянии вызвать lookyloo с помощью ExecScript и передать значение

Например:

Как найти и вызвать метод javascript из vba

Проверено:

Dim ie As InternetExplorer, el
Set ie = New InternetExplorerMedium
ie.Visible = True

ie.navigate "https://www.atb.com/contact-us/Pages/branch-locator.aspx"

Set el = ie.document.getElementById("ba") 'I put a break here while the page loaded...

el.selectedIndex = 5 'for example

ie.document.parentWindow.Window.execScript "lookyloo('" & el.Value & "');"