从上一个网页而不是重定向网页 VBA 填充的 HTML 元素集合

Question

下面的代码导航到网页，用查询填充搜索框，然后提交到结果页面。但是，脚本中的最终元素集合 tdtags（在重定向后定义）是从原始搜索页面而不是结果页面提取数据。我目前在脚本中有 while ie.busy 循环和定时延迟，但两者都不起作用。我也尝试过等待，直到仅出现在结果页面中的元素在 html 中可用，但这也不起作用。Dim twb As WorkbookDim ie As ObjectSet twb = ThisWorkbooktwb.ActivateSet ie = CreateObject("internetexplorer.application")'church = Sheets("Control").Range("A2").Value'minister = Sheets("Control").Range("A4").Valuelocation = "London" 'Sheets("Control").Range("A6").Value'denomination = Sheets("Control").Range("A8").ValueWith ie.navigate "http://www.ukchurch.org/index.php".Visible = TrueDo While .Busy Or .ReadyState <> 4DoEventsLoopEnd WithApplication.Wait (Now + TimeValue("00:00:02"))Set intags = ie.document.getelementsbytagname("input")For Each intag In intagsIf intag.getattribute("name") = "name" ThenIf church <> "" Thenintag.Value = churchEnd IfElseIf intag.getattribute("name") = "minister" ThenIf minister <> "" Thenintag.Value = ministerEnd IfElseIf intag.getattribute("name") = "location" ThenIf location <> "" Thenintag.Value = locationEnd IfElseEnd IfNext intagSet dropopt = ie.document.getelementsbytagname("select")For Each dropo In dropoptIf dropo.classname = "DenominationDropDown" ThenSet opttags = dropo.getelementsbytagname("option")For Each opt In opttagsIf opt.innertext = denomination Thenopt.Selected = TrueEnd IfNext optEnd IfNext dropoOn Error Resume NextFor Each intag In intagsIf intag.getattribute("src") = "images/ukchurch/button-go.jpg" Thenintag.ClickDo While ie.Busy Or ie.ReadyState <> 4DoEventsLoopApplication.Wait (Now + TimeValue("00:00:03"))Exit ForEnd IfNext intagApplication.Wait (Now + TimeValue("00:00:03"))Set tdtags = ie.document.getelementsbytagname("td")For Each td In tdtagsIf td.classname = "pText" ThenDebug.Print td.innertextDebug.Print ie.locationURLpagecount = Right(td.innertext, InStr(td.innertext, ":"))End IfNext tdDebug.Print pagecountEnd Sub任何诊断将不胜感激。

Answer 1

自动化 IE 很痛苦，所以要避免它。

以下函数直接请求结果页面。

Public Function GetSearchResult(Optional ByVal ResultPage As Integer = 0, Optional ByVal ChurchName As String = "", Optional ByVal Minister As String = "", Optional ByVal ChurchLocation As String = "", Optional ByVal Denomination As String = "") As Object

Dim Request As Object: Set Request = CreateObject("MSXML2.serverXMLHTTP")

Dim Result As Object: Set Result = CreateObject("htmlfile")

Request.Open "POST", "http://www.ukchurch.org/searchresults1.php", False

Request.setRequestHeader "content-type", "application/x-www-form-urlencoded"

Request.send IIf(ResultPage = 0, "", "page=" & ResultPage & "&") & "name=" & ChurchName & "&minister=" & Minister & "&location=" & ChurchLocation & "&denomination=" & Denomination

Result.body.innerHTML = Request.responseText

Set GetSearchResult = Result

End Function

打印包含搜索结果的表中tdwith classname的内容的示例pText

Sub Main()

Dim Document As Object

Set Document = GetSearchResult(ChurchLocation:="London")

Dim ResultRows as Object

Dim ResultRow As Object

Set ResultRows = Document.getElementsByTagName("table")(8).getElementsByTagName("td")

For Each ResultRow in ResultRows

    If ResultRow.Classname = "pText" Then

        Debug.print ResultRow.innerText

    End If

Next

End Sub

更新 您需要向 VBA 项目添加一些引用才能使以下代码正常工作。

在 VBA 编辑器中，转到“工具”菜单，单击“引用”，然后在打开的对话框中在以下两项旁边添加复选标记：Microsoft XML, v6.0和Microsoft HTML Object Library(

Public Function GetChurchDetails(ByVal ChurchID As String) As MSHTML.HTMLDocument

Dim Request As New MSXML2.ServerXMLHTTP60

Dim Result As New MSHTML.HTMLDocument

Request.Open "GET", "http://www.ukchurch.org/churchdetails.php?churchid=" & ChurchID, False

Request.send

Result.body.innerHTML = Request.responseText

Set GetChurchDetails = Result

End Function

Sub Main2()

Dim Document As MSHTML.HTMLDocument

Dim Church As MSHTML.HTMLDocument

Set Document = GetSearchResult(ChurchLocation:="London")

Dim ResultRows As MSHTML.IHTMLElementCollection

Dim ResultRow As MSHTML.IHTMLElement

Dim ChurchID As String

'Set ResultRows = Document.getElementsByTagName("table")(8).getElementsByTagName("td")

' all result links on searchresults1.php have a classname of resultslink which makes getting them much easier

Set ResultRows = Document.getElementsByClassName("resultslink")

For Each ResultRow In ResultRows

    ChurchID = ResultRow.getAttribute("href")

    ChurchID = Mid(ChurchID, InStr(1, ChurchID, "=") + 1)

    Set Church = GetChurchDetails(ChurchID)

    ' code to read data from the page using Church as the Document

    ' eg: Church.getElemenetsByTagName("td").....

Next

End Sub

您只需要在提交数据时使用“post”模式，其他一切都可以使用“get”模式