- 帖子
- 3
- 主題
- 0
- 精華
- 0
- 積分
- 5
- 點名
- 0
- 作業系統
- WIN10
- 軟體版本
- office2010
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2016-4-22
- 最後登錄
- 2018-1-29
|
23#
發表於 2016-4-26 14:00
| 只看該作者
回復 22# frankchen7
謝謝GBKEE版大的提示，我修改成下面的方式已可正常抓取
Sub 鉅亨網_歷史行情()
Dim Sh As Worksheet, Code As String, d_Start As String, d_End As String
Dim A As Object, i As Integer, c As Integer, T As Date
Code = InputBox("輸入股票代號:", "股票代號", 2303)
d_End = InputBox("輸入結束日期", "結束日期", Date)
If Len(Code) <= 3 Or Not IsDate(d_End) Then Exit Sub
Set Sh = ActiveSheet
With Sh
.UsedRange.Clear
.[a1] = "股票代碼"
.[b1] = "起始日期"
.[c1] = "結束日期"
.[a2] = Code
.[b2] = DateAdd("yyyy", -3, d_End) '下載三年的歷史股價
.[c2] = d_End
Code = .[a2]
d_Start = Format(.[b2], "yyyy/mm/dd")
d_End = Format(.[c2], "yyyy/mm/dd")
End With
With CreateObject("InternetExplorer.application")
.Navigate "http://www.cnyes.com/twstock/ps_historyprice/" & Code & ".htm"
.Visible = True
Application.StatusBar = Code & "歷史行情 等候中..."
Do While .Busy Or .readyState <> 4
DoEvents
Loop
With .Document
.all("code").Value = Code '填入代碼 (不需要多餘的)
.all("ctl00$ContentPlaceHolder1$startText").Value = d_Start '填入起始時間
.all("ctl00$ContentPlaceHolder1$endText").Value = d_End '填入結束時間
For Each E In .GetElementsByName("ctl00$ContentPlaceHolder1$submitBut")
If E.Value = "查詢" Then E.Click '送出查詢鍵
Next
End With
T = TIME
Do
DoEvents
Loop Until TIME > T + #12:00:08 AM#
Set A = .Document.GetElementsByTagName("table")(1)
Application.StatusBar = Code & "歷史行情 下載中..."
Cells(2, 1) = .Document.GetElementsByTagName("span")(79).innertext
For i = 0 To A.Rows.Length - 1
For c = 0 To A.Rows(i).Cells.Length - 1
Sh.Cells(i + 3, c + 1) = A.Rows(i).Cells(c).innertext
Next
' .Navigate "http://forum.twbts.com/tag.php?name=網頁元素"
' .Visible = True
Next
.Quit
End With
Application.StatusBar = Code & "歷史行情" & Application.Text(TIME - T, "[S] 秒") & "下載完成"
MsgBox "OK"
Application.StatusBar = False
End Sub
:D |
|
