Excel VBScript从网页中复制特定字段中的文本

我有一个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

callmain
主要功能
设置IE=WScript.CreateObject（“InternetExplorer.Application”、“IE”）
可见=真实
即“导航”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
循环计数=2
不为空时执行（xl.Cells（loopCount，1.Value）
昏暗的我
模糊值
a=xl.Cells（loopCount，1）.Value
b=xl.单元格（循环计数，2）.值
c=xl.单元格（loopCount，3）.值
等等
IE.Document.All.Item（“sortcode1”）。值=a
IE.Document.All.Item（“sortcode2”）。值=b
IE.Document.All.Item（“sortcode3”）。值=c
IE.Document.getElementsByName（“检查排序代码”）。项（0）。单击
loopCount=loopCount+1
环
端函数
分段等待（IE）
做
WScript.Sleep 500
当IE.ReadyState<4且IE.Busy时循环
端接头

---

有人能告诉我如何提取结果吗？

因为它们嵌套在带有类名的

标记下，所以可以利用段落类来查找结果的html

类名：

scv\u success\u untick

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

有了这些类名，我们可以遍历所有

，检查

类名

，并在找到后收集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

结果屏幕截图

---

这太棒了，Rich，很好用。我需要解决的唯一问题是，当有一个排序代码找不到时，它只会使用以前的结果。@BrianG哦，好吧，这很简单，只需在

xl.Cells（loopCount，4）之后使用
result=“”：result2=“”
，Value=result:xl.Cells（loopCount，5）.Value=result2

，以便在将变量保存到excel工作表后清除这些变量。再次完美工作。

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

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