从具有标签名称"table"且没有其他内容的网站表中提取数据



要导入的数据位于一个表中,该表的标记名为"table",没有其他内容。

当我分配页面中的所有表时,我认为它不算作一个表。

Sub PullData()
Dim IE As New SHDocVw.InternetExplorer
Dim hdoc As MSHTML.HTMLDocument
Dim HEL As MSHTML.IHTMLElement
Dim ha, hb, hc, hd, he, hf, hg, hh, hi, hj As String
Dim i, x As Integer
i = 2
IE.Visible = True
IE.navigate "https://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=FEL"
Do While IE.readyState <> READYSTATE_COMPLETE
Loop
Set hdoc = IE.document
Set HEL = hdoc.getElementById("tab8")
HEL.Click
Set HEL = hdoc.getElementById("period")
HEL.Value = "3months"
Set HEL = hdoc.getElementById("get")
HEL.Click
End Sub

您可以在URL中使用查询字符串来返回该信息。这意味着您可以直接使用速度更快的XMLHTTP方法,该方法比打开浏览器并进行选择要快得多。

Option Explicit
Public Sub GetTable()
Dim sResponse As String, html As HTMLDocument, clipboard As Object, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/getHistoricalData.jsp?symbol=FEL&series=EQ&fromDate=undefined&toDate=undefined&datePeriod=3months", False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
sResponse = StrConv(.responseBody, vbUnicode)
End With
Set html = New HTMLDocument
html.body.innerHTML = sResponse
clipboard.SetText html.querySelector("table").outerHTML
clipboard.PutInClipboard
ws.Cells(1, 1).PasteSpecial
End Sub

不太整洁的是拦截用于文件下载的URL并使用该URL进行二进制下载:

Option Explicit
Public Sub DownloadFile()
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/getHistoricalData.jsp?symbol=FEL&series=EQ&fromDate=undefined&toDate=undefined&datePeriod=3months&hiddDwnld=true", False
http.send
With CreateObject("ADODB.Stream")
.Open
.Type = 1
.write http.responseBody
.SaveToFile "C:UsersUserDesktopTestDownload.csv" '<== specify your path here
.Close
End With
Debug.Print "FileDownloaded"
Exit Sub
errhand:
If Err.Number <> 0 Then
Debug.Print Err.Number, Err.Description
MsgBox "Download failed"
End If
End Sub

最新更新