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

Question

下面的代码导航到网页，用查询填充搜索框，然后提交到结果页面。但是，脚本中的最终元素集合 tdtags（在重定向后定义）是从原始搜索页面而不是结果页面提取数据。我目前在脚本中有 while ie.busy 循环和定时延迟，但两者都不起作用。我也尝试过等待，直到仅出现在结果页面中的元素在 html 中可用，但这也不起作用。

Dim twb As Workbook

Dim ie As Object

Set twb = ThisWorkbook

twb.Activate

Set ie = CreateObject("internetexplorer.application")

'church = Sheets("Control").Range("A2").Value

'minister = Sheets("Control").Range("A4").Value

location = "London" 'Sheets("Control").Range("A6").Value

'denomination = Sheets("Control").Range("A8").Value

With ie

.navigate "http://www.ukchurch.org/index.php"

.Visible = True

Do While .Busy Or .ReadyState <> 4

DoEvents

Loop

End With

Application.Wait (Now + TimeValue("00:00:02"))

Set intags = ie.document.getelementsbytagname("input")

For Each intag In intags

If intag.getattribute("name") = "name" Then

If church <> "" Then

intag.Value = church

End If

ElseIf intag.getattribute("name") = "minister" Then

If minister <> "" Then

intag.Value = minister

End If

ElseIf intag.getattribute("name") = "location" Then

If location <> "" Then

intag.Value = location

End If

Else

End If

Next intag

Set dropopt = ie.document.getelementsbytagname("select")

For Each dropo In dropopt

If dropo.classname = "DenominationDropDown" Then

Set opttags = dropo.getelementsbytagname("option")

For Each opt In opttags

If opt.innertext = denomination Then

opt.Selected = True

End If

Next opt

End If

Next dropo

On Error Resume Next

For Each intag In intags

If intag.getattribute("src") = "images/ukchurch/button-go.jpg" Then

intag.Click

Do While ie.Busy Or ie.ReadyState <> 4

DoEvents

Loop

Application.Wait (Now + TimeValue("00:00:03"))

Exit For

End If

Next intag

Application.Wait (Now + TimeValue("00:00:03"))

Set tdtags = ie.document.getelementsbytagname("td")

For Each td In tdtags

If td.classname = "pText" Then

Debug.Print td.innertext

Debug.Print ie.locationURL

pagecount = Right(td.innertext, InStr(td.innertext, ":"))

End If

Next td

Debug.Print pagecount

End 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 ObjectDim 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", FalseRequest.setRequestHeader "content-type", "application/x-www-form-urlencoded"Request.send IIf(ResultPage = 0, "", "page=" & ResultPage & "&") & "name=" & ChurchName & "&minister=" & Minister & "&location=" & ChurchLocation & "&denomination=" & DenominationResult.body.innerHTML = Request.responseTextSet GetSearchResult = ResultEnd Function打印包含搜索结果的表中tdwith classname的内容的示例pTextSub Main()Dim Document As ObjectSet Document = GetSearchResult(ChurchLocation:="London")Dim ResultRows as ObjectDim ResultRow As ObjectSet ResultRows = Document.getElementsByTagName("table")(8).getElementsByTagName("td")For Each ResultRow in ResultRows&nbsp; &nbsp; If ResultRow.Classname = "pText" Then&nbsp; &nbsp; &nbsp; &nbsp; Debug.print ResultRow.innerText&nbsp; &nbsp; End IfNextEnd Sub更新 您需要向 VBA 项目添加一些引用才能使以下代码正常工作。在 VBA 编辑器中，转到“工具”菜单，单击“引用”，然后在打开的对话框中在以下两项旁边添加复选标记：Microsoft XML, v6.0和Microsoft HTML Object Library(Public Function GetChurchDetails(ByVal ChurchID As String) As MSHTML.HTMLDocumentDim Request As New MSXML2.ServerXMLHTTP60Dim Result As New MSHTML.HTMLDocumentRequest.Open "GET", "http://www.ukchurch.org/churchdetails.php?churchid=" & ChurchID, FalseRequest.sendResult.body.innerHTML = Request.responseTextSet GetChurchDetails = ResultEnd FunctionSub Main2()Dim Document As MSHTML.HTMLDocumentDim Church As MSHTML.HTMLDocumentSet Document = GetSearchResult(ChurchLocation:="London")Dim ResultRows As MSHTML.IHTMLElementCollectionDim ResultRow As MSHTML.IHTMLElementDim 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 easierSet ResultRows = Document.getElementsByClassName("resultslink")For Each ResultRow In ResultRows&nbsp; &nbsp; ChurchID = ResultRow.getAttribute("href")&nbsp; &nbsp; ChurchID = Mid(ChurchID, InStr(1, ChurchID, "=") + 1)&nbsp; &nbsp; Set Church = GetChurchDetails(ChurchID)&nbsp; &nbsp; ' code to read data from the page using Church as the Document&nbsp; &nbsp; ' eg: Church.getElemenetsByTagName("td").....NextEnd Sub您只需要在提交数据时使用“post”模式，其他一切都可以使用“get”模式