使用 VBA 点击 javascript href link

Question

我正在尝试自动执行一个程序，该程序会查找特定地块的属性税收 returns。我使用的网站是 here。

在此示例中，我要查找的包裹 ID 是 648-30-013。

当我搜索那个包裹时，我到达了一个包含 link 的页面，我需要点击它。 link 的 html 如下：

<a href='javascript:SubmitThisForm("General.asp", "64830013");'>648-30-013</a>

我试过使用以下代码点击 link，但没有成功。我遇到问题的部分是最后一节“点击包裹 ID link”。单步执行时代码工作正常，但执行时 objCollection 变量不会填充。

'Declare Variables

' Counter variable
Dim i As Integer

' Internet explorer variables
Dim IE As Object
Dim objElement As Object
Dim objCollection As Object
Dim lookupURL As String

' Excel variables
Dim currentParcel As String
Dim year As Integer
Dim jobs As String
Dim completedLoops
Dim totalLoops

' Input variables
'These are the counter variables that loop through your lookup data; where to start and end and how long to loop for
completedLoops = 0
totalLoops = 1
lookupURL = "http://fiscalofficer.cuyahogacounty.us/AuditorApps/real-property/REPI/default.asp"


'Set value of current lookup based on a starting value and # of loops completed
currentParcel = "648-30-013"
Application.StatusBar = "Executing " & completedLoops & " of " & totalLoops & " loops"


' Establish Internet Exploere Instance
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

' Navigate to website
IE.Navigate lookupURL

' Wait while IE loading...
Do While IE.Busy
    Application.Wait DateAdd("s", 1, Now)
Loop

' Click on 'By Parcel #' tab
' Create a list of all the <div> tags on the page
Set objCollection = IE.document.getElementsByTagName("div")

' Loop through all <div> tags to find the one with the correct name and input current search term into tag
i = 0
Do While i < objCollection.Length
    If objCollection(i).ID = "tabTabdhtmlgoodies_tabView2_1" Then
        Set objElement = objCollection(i)
        objElement.Click
        Exit Do
    End If
    i = i + 1
    Loop

Do While IE.Busy
    Application.Wait DateAdd("s", 1, Now)
Loop


' Input parcel ID
Set objCollection = IE.document.getElementsByTagName("input")
i = 0
Do While i < objCollection.Length
    If objCollection(i).Name = "parcelNum" Then
        objCollection(i).Value = currentParcel
        Exit Do
    End If
    i = i + 1
    Loop

Do While IE.Busy
    Application.Wait DateAdd("s", 1, Now)
Loop

' Click on search button
Set objCollection = IE.document.getElementsByTagName("input")
i = 0
Do While i < objCollection.Length
    If objCollection(i).Name = "b_2" Then
        Set objElement = objCollection(i)
        objElement.Click
        Exit Do
    End If
    i = i + 1
    Loop

Application.Wait DateAdd("s", 5, Now)


' Click on parcel ID link
Set objCollection = IE.document.getElementsByTagName("a")
Debug.Print objCollection.Length
i = 0
Do While i < objCollection.Length
    If objCollection(i).innerText = currentParcel Then
        Debug.Print objCollection(i).innerText
        Set objElement = objCollection(i)
        objElement.Click
        Exit Do
    End If
    i = i + 1
    Loop

如果有更好的点击方式请告诉我link。

Answer 1

这对我有用。

如果您正在进行任何数量的网络抓取，那么将尽可能多的 "guts" 抽象为实用方法会更清晰，您可以重复使用这些实用方法并帮助您整理主要内容代码，因此您可以更轻松地关注 "what" 与 "how"。

Sub TT()

    Dim i As Integer
    Dim IE As Object
    Dim objElement As Object
    Dim objCollection As Object
    Dim lookupURL As String, div As Object, el As Object
    Dim currentParcel As String
    Dim year As Integer
    Dim jobs As String
    Dim completedLoops
    Dim totalLoops


    completedLoops = 0
    totalLoops = 1
    lookupURL = "http://fiscalofficer.cuyahogacounty.us/AuditorApps/real-property/REPI/default.asp"

    currentParcel = "648-30-013"

    Application.StatusBar = "Executing " & completedLoops & " of " & totalLoops & " loops"

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True

    IE.Navigate lookupURL ' Navigate to website
    WaitFor IE

    Set div = IE.document.getelementById("tabTabdhtmlgoodies_tabView2_1")

    If Not div Is Nothing Then

        div.Click
        WaitFor IE
        ' Input parcel ID
        If PopulateInputByName(IE, "parcelNum", currentParcel) Then

            Application.Wait DateAdd("s", 2, Now)

            Set el = GetNamedInput(IE, "b_2")
            If Not el Is Nothing Then

                el.Click
                Application.Wait DateAdd("s", 5, Now)

                Set el = GetLinkByText(IE, currentParcel)
                If Not el Is Nothing Then el.Click 'done!

            Else
                MsgBox "Input 'b_2' not found!"
            End If


        Else
            MsgBox "ParcelNum input not found!"
        End If

    Else
        MsgBox "Tab div not found!"
    End If

End Sub

'*** Begin utility functions ***
'utility: wait until page has loaded
Sub WaitFor(IE As Object)
    Do While IE.ReadyState < 4 Or IE.Busy
        DoEvents
    Loop
End Sub

'utility: find a named input and set its value: return True if this succeeded
Function PopulateInputByName(IE, theName, theValue) As Boolean
    Dim el As Object, rv As Boolean
    Set el = GetNamedInput(IE, theName)
    If Not el Is Nothing Then
        el.Value = theValue
        rv = True
    End If
    PopulateInputByName = rv
End Function

'utility: find a named input
Function GetNamedInput(IE, theName) As Object
    Dim objColl As Object, el As Object, rv As Object
    Set objColl = IE.document.getElementsByTagName("input")
    For Each el In objColl
        If el.Name = theName Then
            Set rv = el
            Exit For
        End If
    Next
    Set GetNamedInput = rv
End Function

'utility: click link with specific text
Function GetLinkByText(IE, theText) As Object
    Dim objColl As Object, el As Object, rv As Object
    Set objColl = IE.document.getElementsByTagName("a")
    For Each el In objColl
        If el.innerText = theText Then
            Set rv = el
            Exit For
        End If
    Next
    Set GetLinkByText = rv
End Function

使用 VBA 点击 javascript href link

Use VBA to Click on javascript href link

javascript

excel

vba

href