VBScript从Web页面复制特定字段的文本

时间:2014-04-25 11:24:30

标签: excel web vbscript copy extract

我有一个vbscript代码,用于打开网页,插入查询并运行查询。我需要的是一种将查询结果提取到Excel电子表格的方法。

到目前为止,这是我的代码:

    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

有谁能告诉我如何提取结果?

1 个答案:

答案 0 :(得分:0)

由于它们嵌套在带有类名的<p>标记下,因此您可以使用段落类来查找结果的html。

班级名称: scv_success_untick

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

班级名称: scv_success_untick_branch

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

使用这些类名,我们可以遍历所有<p>并检查classname并在找到后收集innerHTML。

    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

由于我们无法直接定位textarea,因此我们必须解析HTML才能这样做。为了解决这个问题,我编写了一个小的replace()函数来删除字符串中的所有html标记。

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

现在我们已经取消了结果,我们所拥有的只有以下结果:
Institution: HALIFAX (A TRADING NAME OF BANK OF SCOTLAND PLC)

以下更新的代码。

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

结果屏幕截图。

output