下面的代碼導航到網頁，用查詢填充搜索框，然后提交到結果頁面。但是，腳本中的最終元素集合 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任何診斷將不勝感激。
1 回答
臨摹微笑
TA貢獻1982條經驗 獲得超2個贊
自動化 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”模式
- 1 回答
- 0 關注
- 187 瀏覽
添加回答
舉報
0/150
提交
取消