【发布时间】:2020-10-15 11:19:29
【问题描述】:
我通过使用 excel 复制和粘贴来完成这项工作,而不是通过正确的网络抓取。我有兴趣只从主表中捕获数据,但相反,我会在我的响应中获取所有内容。我怎样才能得到主表?我尝试使用..." Set HTMLTables = HTMLDoc.getElementsByTagName("tbody").Item("3") "
Sub IE_DropDownSelect_and_Click()
Dim ie As New SHDocVw.InternetExplorer
Dim htmlDoc As New MSHTML.HTMLDocument
Dim HTMLTables As MSHTML.IHTMLElementCollection
Dim HTMLTable As MSHTML.IHTMLElement
Dim TableSection As MSHTML.IHTMLElement
Dim TableRow As MSHTML.IHTMLElement
Dim TableCell As MSHTML.IHTMLElement
Dim RowCount As Integer
Dim ColCount As Integer
Dim HTMLa As MSHTML.IHTMLElement 'TagName("a")
Dim HTMLas As MSHTML.IHTMLElementCollection 'TagName("as")
Dim RowText As String
Dim TimeFrame As Integer
Dim TimeFrame2 As String
Dim URL As String
TimeFrame2 = 1
URL = "https://forecast.weather.gov/MapClick.php?w0=t&w3=sfcwind&w3u=1&w4=sky&w5=pop&w6=rh&w7=rain&AheadHour=0&Submit=Submit&FcstType=digital&textField1=33.6414&textField2=-116.2591&site=all&unit=0&dd=&bw="
ie.Visible = True
ie.navigate URL
Do While ie.readyState <> READYSTATE_COMPLETE
Loop
Set htmlDoc = ie.document
TimeFrame = Worksheets("Selector").Range("B1").Value
TimeFrame2 = CStr(TimeFrame)
'htmlDoc.querySelector("[name=AheadHour] option[value='8']").Selected = True
htmlDoc.querySelector("[name=AheadHour] option[value='" & TimeFrame2 & "'").Selected = True
Application.Wait (Now + TimeValue("0:00:1"))
htmlDoc.getElementById("submit").Click
Application.Wait (Now + TimeValue("0:00:2"))
Worksheets("sheet1").Activate
ActiveSheet.Cells.NumberFormat = "General"
Set HTMLTables = htmlDoc.getElementsByTagName("table")
'Set HTMLTables = HTMLDoc.getElementsByTagName("tbody").Item("3")
For Each HTMLTable In HTMLTables
'Debug.Print HTMLTable.Id, HTMLTable.className; vbCr
For Each TableSection In HTMLTable.Children
'Debug.Print , TableSection.tagName
'For Each TableRow In TableRow.tagName("tr")
For Each TableRow In TableSection.Children
RowText = ""
'For Each TableCell In TableCell.tagName("td")
For Each TableCell In TableRow.Children
ColCount = ColCount + 1: Cells(RowCount + 1, ColCount).NumberFormat = "@": Cells(RowCount + 1, ColCount) = RowText & vbTab & TableCell.innerText
'RowText = RowText & vbTab & TableCell.innerText
Next TableCell
ColCount = 0
RowCount = RowCount + 1
Debug.Print , , RowText
Next TableRow
Next TableSection
Next HTMLTable
End Sub
【问题讨论】:
-
提供测试值和预期输出很有用。您显示的代码适用于您应该更新的所有表,以显示重现问题的确切示例。
标签: html excel vba web web-scraping