0

I am creating a macro to grab Fax Numbers from a public banking website.

I have written enough code to get to the site, select from a dropdown list, and change the selection in the dropdown list. However when I use FireEvent ("onChange"), it does not trigger the webpage to update.

I have searched for an answer, but have not found any.

Website: 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
Community
  • 1
  • 1
Arfan
  • 1
  • 1
  • 1
  • Why do you need the `onchange` event? It looks like if you select a drop down option, the webpage updates almost instantly. Is the `onchange` supposed to detect that change? – BruceWayne Dec 07 '18 at 16:29
  • 1
    Hi, when i manually do this with my mouse, you're correct, the site changes instantly. However when coding through VBA, it simply selects the branch from the dropdown, but does not trigger the webpage to change. This is why I tried using the OnChange event, as this has worked for me with other websites. However with this one, it doesn't do anything. There must be some form of event that needs to be triggered for the webpage to change. Onchange in this case does not work. – Arfan Dec 07 '18 at 17:00

3 Answers3

1

I would use XMLHTTP/WinHttp POST request and grab the xml and then parse that. You could adapt as a function. I would prefer to grab all the fax numbers in one go and write out to sheet. I use xpath to retrieve the title (name of branch) and the fax numbers.

You could adapt the xpath syntax to retrieve any of the listed values. E.g row returned from which you could select values:

<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

Sample of results:

QHarr
  • 83,427
  • 12
  • 54
  • 101
0

Looks like the select change is set up by this code:

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

You should be able to call lookyloo using ExecScript and pass in the value

Eg:

How to find and call javascript method from vba

Tested:

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 & "');"
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • Hi Tim, Thank you so much for your response! Do you mind showing me an example of what you mean? Not sure what a lookyloo is. Would it just be like execscript(lookyloo(i))? – Arfan Dec 07 '18 at 17:23
  • `lookyloo` is just a javascript function defined in the page by the authors, to manage the process of responding to a change in the select. You can call it directly from VBA instead of trying to do so by firing the change event. – Tim Williams Dec 07 '18 at 17:26
  • Tim you are the MAN! with some rearranging I got it to work! Thank you SO much. Can i kindly ask you, where/how did you find this lookyloo function? I tried looking through the inspect element option on IE, and i even looked at the source code, but could not find this. Do you mind advising how you came to this? – Arfan Dec 07 '18 at 17:48
  • Load page in Chrome >> right click on the "select a location" drop-down and choose "Inspect" >> in the right-hand pane of the Developer Tools window under "Event Listeners" expand "change" >> click link to js file "branch-locate..." >> look at the code there. – Tim Williams Dec 07 '18 at 17:52
0

I had a similar issue and got it to work by changing "onchange" to ("onchange").

Mike W.
  • 1