使用 msXML2.xmlHTTP 取得股票交易資料 - Excel程式區

[發問] 使用 msXML2.xmlHTTP 取得股票交易資料

1^# 跳轉到 »

發表於 2017-6-30 15:18 | 顯示全部帖子

提供自己寫的讀取table程式碼，但套用到你提供的網頁，table讀出來只有1個欄位，如下圖

"股票
代號時間成交買進賣出漲跌張數昨收開盤最高最低個股資料
2330台積電
加到投資組合
14:30208.5208.0208.5▽1.5 30,867210.0206.5208.5206.5成交明細
技術　新聞
基本　籌碼
個股健診"

不知有高手有方法解決嗎？

Sub main()
Dim URL$, VV As Boolean, AB() As String
URL = "https://tw.stock.yahoo.com/q/q?s=2330"
AB = GetWebTb1(URL, 6, 1, 1, VV)
If VV = True Then ActiveSheet.Range("A1") = AB
End Sub
Private Function GetWebTb1(sURL00$, nTT00%, nRR00%, nCC00%, bRd00 As Boolean)
'===sURL00 為擷取網址
'===nTT00 為讀取第幾個Table(從1開始)
'===nRR00 該Table由第幾列開始讀取(從1開始)
'===nCC00 該Table由第幾欄開始讀取(從1開始)
'===bRd00 該資料是否輸出
Dim nR00%, nC00%, sTemp() As String, oXml As Object, oDoc As Object, oE As Object, tt As Date
Set oXml = CreateObject("MSXML2.XMLHTTP.6.0")
Set oDoc = CreateObject("HTMLFile")
bRd00 = True
rSend:
tt = Now() + TimeValue("0:00:20")
With oXml
.Open "Get", sURL00, True
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
.send
On Error Resume Next
Do While .ReadyState <> 4 Or .Status <> 200
DoEvents
If Now > tt Then GoTo rSend
Loop
On Error GoTo 0
oDoc.write .responseText
End With
If oDoc.all.tags("Table")(nTT00 - 1) Is Nothing Then bRd00 = False: GoTo Err1
Set oE = oDoc.all.tags("Table")(nTT00 - 1)
With oE
ReDim sTemp(.Rows.Length - nRR00, .Rows(nRR00 - 1).Cells.Length - nCC00)
For nR00 = 0 To .Rows.Length - nRR00
For nC00 = 0 To .Rows(nR00 + nRR00 - 1).Cells.Length - nCC00
sTemp(nR00, nC00) = .Rows(nR00 + nRR00 - 1).Cells(nC00 + nCC00 - 1).innerText
Next nC00
Next nR00
End With
Err1:
GetWebTb1 = sTemp
oXml.abort
oDoc.Close
Set oXml = Nothing
Set oDoc = Nothing
Set oE = Nothing
End Function

複製代碼

2^#

發表於 2017-7-4 14:20 | 顯示全部帖子

回復 7# Scott090

謝啦！從你的code多約會了resize這個用法，好用！
原來我table數錯了，是第七個，不是第六個，
其實我不會數到底是第幾個table，
我是土法煉鋼一個一個輸出，看到底是要那一個table，
結果還是敗在這，不知有沒有較有效率的方法呢？

靜思自在 : 要批評別人時，先想想自己是否完美無缺。