0

我正在创建一个宏来从公共银行网站获取传真号码。

我已经编写了足够的代码来访问该站点，从下拉列表中进行选择，然后更改下拉列表中的选择。但是，当我使用 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
4

3 回答 3

1

我会使用 XMLHTTP/WinHttp POST 请求并获取 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

结果样本：

于 2018-12-07T18:28:11.080 回答
0

看起来选择更改是由以下代码设置的：

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

您应该能够调用lookyloousingExecScript并传入值

例如：

如何从 vba 中查找和调​​用 javascript 方法

测试：

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 & "');"
于 2018-12-07T17:12:45.597 回答
0

我有一个类似的问题，并通过将“onchange”更改为（“onchange”）来使其工作。

于 2020-01-03T14:32:58.697 回答