VBScript to copy text from a specific field from Web Page

Question

I have a vbscript code that opens a webpage, inserts a query and runs the query. What I need is a way to extract the results of that query to an Excel spreadsheet.

Here is my code so far:

    Call Main
Function Main 
    Set IE = WScript.CreateObject("InternetExplorer.Application", "IE_")
    IE.Visible = True
    IE.Navigate "http://www.paymentscouncil.org.uk/resources_and_publications/sort_code_checker/"

Set xl = CreateObject("Excel.application")
xl.Application.Workbooks.Open "U:\Test\Test2.xlsm"
xl.Application.Visible = True

loopCount = 2

Do while not isempty(xl.Cells(loopCount, 1).Value)
  Dim i       
  Dim value   

    a = xl.Cells(loopCount, 1).Value
    b = xl.Cells(loopCount, 2).Value
    c = xl.Cells(loopCount, 3).Value


Wait IE
    IE.Document.All.Item("sortcode1").value = a
    IE.Document.All.Item("sortcode2").value = b
    IE.Document.All.Item("sortcode3").value = c
    IE.Document.getElementsByName("Check Sort Code").Item(0).Click

loopCount = loopCount + 1
Loop


End Function




Sub Wait(IE)
  Do
    WScript.Sleep 500
  Loop While IE.ReadyState < 4 And IE.Busy
End Sub

Can anyone tell me how to extract the results?

Answer 1

Since they are nested under a <p> tag with a class name, you can utilize the paragraph class to find the html of the results.

Class Name: scv_success_untick

<p class="scv_success_untick">Institution: <textarea readonly="">HALIFAX (A TRADING NAME OF BANK OF SCOTLAND PLC)</textarea></p>

Class Name: scv_success_untick_branch

<p class="scv_success_untick_branch">Branch/Office: <textarea readonly="">EASTCOTE</textarea></p>

With these class names, we can iterate through all the <p>'s and check the classname and collect the innerHTML once found.

    Dim result
    Set objElms = IE.Document.getElementsByTagName("p")
    For Each objElm In objElms
        If objElm.className = "scv_success_untick" Then
            result = objElm.innerHTML
        End If
    Next

Since we can't target the textarea directly, we'll have to parse out the HTML to do so. To fix this, I wrote a small replace() function that strips out all html tags in a string.

            Do While InStr(result, ">") > 0
                result = Replace(result, Mid(result, InStr(result, "<"), InStr(result, ">") - InStr(result, "<") + 1), "")
            Loop

Now that we have stripped the results, all we have is the following result:
Institution: HALIFAX (A TRADING NAME OF BANK OF SCOTLAND PLC)

Updated Code Below.

Main
Function Main 
    Set IE = WScript.CreateObject("InternetExplorer.Application", "IE_")
    IE.Visible = True
    IE.Navigate "http://www.paymentscouncil.org.uk/resources_and_publications/sort_code_checker/"

    Set xl = CreateObject("Excel.application")
    xl.Application.Workbooks.Open "U:\Test\Test2.xlsm"
    xl.Application.Visible = True

    loopCount = 2

    Do While Not IsEmpty(xl.Cells(loopCount, 1).Value)
        Dim i       
        Dim value   

        a = xl.Cells(loopCount, 1).Value
        b = xl.Cells(loopCount, 2).Value
        c = xl.Cells(loopCount, 3).Value
        Wait IE
        IE.Document.All.Item("sortcode1").value = a
        IE.Document.All.Item("sortcode2").value = b
        IE.Document.All.Item("sortcode3").value = c
        IE.Document.getElementsByName("Check Sort Code").Item(0).Click
        Wait IE
        Dim result, result2
        Set objElms = IE.Document.getElementsByTagName("p")
        For Each objElm In objElms
            If objElm.className = "scv_success_untick" Then
                result = objElm.innerHTML
                Do While InStr(result, ">") > 0
                    result = Replace(result, Mid(result, InStr(result, "<"), InStr(result, ">") - InStr(result, "<") + 1), "")
                Loop
            ElseIf objElm.className = "scv_success_untick_branch" Then
                result2 = objElm.innerHTML
                Do While InStr(result2, ">") > 0
                    result2 = Replace(result2, Mid(result2, InStr(result2, "<"), InStr(result2, ">") - InStr(result2, "<") + 1), "")
                Loop
            End If
        Next
        xl.Cells(loopCount, 4).Value = result
        xl.Cells(loopCount, 5).Value = result2
        loopCount = loopCount + 1
    Loop


End Function
Sub Wait(IE)
    Do
        WScript.Sleep 500
    Loop While IE.ReadyState < 4 And IE.Busy
End Sub

Resultant Screen Shot.