(不定期更新)使用VBA解決 excel web 查詢無法匯入、匯入太慢的股市資料

樓主好
在第369樓中看到兩個URL
http://sod.nsc.com.tw/z/zc/zcl/zcl_1101.djhtm
http://sod.nsc.com.tw/z/zc/zcl/zcl.djhtm?a=1101&c=2018-8-1&d=2018-8-20

我在後面還看到一個URL
http://sod.nsc.com.tw/Z/ZC/ZCL/CZCL3.DJBCD?A=1101&B=Y

這有更大範圍的資料,像這樣的我要如何種抓取?
我是可以用ie object方式抓. 但想問看看更快的方式
因為我想抓以下的資料.
http://sod.nsc.com.tw/Z/ZC/ZCW/ZCW_1101_A.djhtm
http://sod.nsc.com.tw/Z/ZC/ZCW/CZKC1.djbcd?a=1101&b=A&c=1440

感恩您的答覆
alantsai5840 wrote:
https://www.cnyes.com/twstock/a_price4.aspx 去抓起 OTC 歷史日期的資料如2018-08-10 一直抓2018-08-17 TSE資料 ...(恕刪)





這個用xmlhttp會很麻煩喔,請參考269樓的寫法
因為從網頁原始碼可知,選單是 java (asp.net),不是按鈕,而預設值是最新的日期
加上點選選單時
__VIEWSTATE、__EVENTVALIDATION、__VIEWSTATEGENERATOR…等等的數值就會改變一次
ctl00$ContentPlaceHolder1$D3(日期)這個變數才會更改
再由後台asp.net 產生資料
因變數太多,處理起來會很麻煩,雖然寫法類似269樓,但是複雜多了

所以建議您,換成別的資料來源網站
或改用ie object
(xmlhttp寫法,請參考456樓)
簡單寫法如下
'=============================================
Sub test()

Dim url As String, OpenCnyes As Object

url = "https://www.cnyes.com/twstock/a_price4.aspx"

Set OpenCnyes = CreateObject("InternetExplorer.Application")

With OpenCnyes
.Visible = True
.navigate url

Do Until .readyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop

.document.all("ctl00$ContentPlaceHolder1$D1").Value = "OTC"
.document.all("ctl00$ContentPlaceHolder1$D3").Value = "2018-08-14"
.document.all("__EVENTTARGET").Value = "ctl00$ContentPlaceHolder1$D3"
.document.all("aspnetForm").Submit

Do Until .readyState = 4: DoEvents: Loop

'===============
'這裡填入使用ie object 抓資料的程式碼(google範例很多,不多做說明)


'===============

' OpenCnyes.Quit
End With

Set OpenCnyes = Nothing

End Sub
'=============================================

yuhuahsiao wrote:
因為我想抓以下的資料.
http://sod.nsc.com.tw/Z/ZC/ZCW/ZCW_1101_A.djhtm
http://sod.nsc.com.tw/Z/ZC/ZCW/CZKC1.djbcd?a=1101&b=A&c=1440...(恕刪)



http://sod.nsc.com.tw/Z/ZC/ZCW/ZCW_1101_A.djhtm
這是K線圖… vba 沒辦法抓動態圖表,最多只能抓靜態的


http://sod.nsc.com.tw/Z/ZC/ZCW/CZKC1.djbcd?a=1101&b=A&c=1440
這是?? k線圖的數據資料嗎??

不用特殊技巧啊??幾行就搞定了
'=================================
Sub sinotrade()


Dim URL As String, GetXml As Object

Set GetXml = CreateObject("msxml2.xmlhttp")

URL = "http://sod.nsc.com.tw/Z/ZC/ZCW/CZKC1.djbcd?a=1101&b=A&c=1440"

With GetXml
.Open "GET", URL, False
.send

Debug.Print .responsetext

End With

Set GetXml = Nothing
End Sub

'==================================
感謝樓主.
所以這些純文字的就不create 成htmlfile,了解了
用xmlhttp 真的比ie 快很多

另那些資料確實是K線圖的資料

感謝snare大 的指導 將依snare大的指示學習
範例網址:
鉅亨網 (盤後資訊=>類股成交金額漲跌幅及市值比較)
https://www.cnyes.com/twstock/a_price4.aspx






這個範例呢,本來不想po的,雖然程式碼不長
但因為是使用aspx的網站,選單的點選是用java做的,不是一般的listbox、按鈕…等等
用一般的寫法,只能下載到集中市場(TSE)最新一天的資料
店頭市場(OTC)或其它較早的日期,會無法正確取得

所以難度偏高,需要一點點分析網站原始碼的能力
才比較容易看懂我在寫什麼

後來想想,相關範例,只有在269樓寫過一次
所以想想還是po出來好了,這樣大家就有2篇可以參考

(如果對速度不要求,可以回頭看452樓,改用 ie object 會比較簡單)



'===================================
'程式碼放在模組裡
'注意:inputbox自己加,OTC、TSE自己改,日期範圍自己限制,或試著從網站上抓可用的日期
'怎麼寫請回頭找相關範例
'===================================



Sub Get_cnyes()

ttt = Timer

Dim Xmlhttp As Object, HtmlSourcecode As Object, url As String, TseOtc As String, temparray(), StartDay As String, vs As String, ev As String, url_a As String, For_Debug_Response As String

Set HtmlSourcecode = CreateObject("htmlfile")
Set Xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")

url = "https://www.cnyes.com/twstock/a_price4.aspx"

With Xmlhttp

.Open "GET", url, False
.setRequestHeader "Connection", "Keep-Alive"
.send

vs = Split(Split(.responsetext, "__VIEWSTATE"" value=""")(1), """")(0)
ev = Split(Split(.responsetext, "__EVENTVALIDATION"" value=""")(1), """")(0)
vg = Split(Split(.responsetext, "__VIEWSTATEGENERATOR"" value=""")(1), """")(0)

End With

StartDay = "2018-08-17" '注意日期範圍
TseOtc = "OTC" 'TSE or OTC (集中市場、店頭市場,預設OTC)

url_a = "ctl00$ContentPlaceHolder1$ScriptManager1=ctl00$ContentPlaceHolder1$UpdatePanel2|ctl00$ContentPlaceHolder1$D3" & _
"&__EVENTTARGET=ctl00$ContentPlaceHolder1$D3" & "&__EVENTARGUMENT=" & "&__LASTFOCUS=" & _
"&__VIEWSTATE=" & UrlEncode(vs) & _
"&__VIEWSTATEGENERATOR=" & vg & _
"&__EVENTVALIDATION=" & UrlEncode(ev) & _
"&ctl00$ContentPlaceHolder1$D1=" & TseOtc & _
"&ctl00$ContentPlaceHolder1$D3=" & StartDay


With Xmlhttp
.Open "POST", url, False
.setRequestHeader "Referer", url
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Content-Length", Len(url_a)
.setRequestHeader "Connection", "Keep-Alive"
.send (url_a)

HtmlSourcecode.body[removed] = .responsetext

For_Debug_Response = HtmlSourcecode.getelementbyid("ctl00_ContentPlaceHolder1_UpdatePanel1").innertext

'this table only for test
Set Table = HtmlSourcecode.all.tags("table")(2).Rows
ReDim temparray(Table.Length - 1, Table(2).Cells.Length - 1)

For I = 0 To Table.Length - 1
For j = 0 To Table(I).Cells.Length - 1
temparray(I, j) = Table(I).Cells(j).innertext
Next j
Next I

With Sheets("工作表1")
.Cells.Clear
.Range(.Cells(1, 1), .Cells(Table.Length, Table(2).Cells.Length)) = temparray()
.Cells.EntireColumn.AutoFit
.Cells(1, 1).Select
End With

Erase temparray()
Set Xmlhttp = Nothing
Set HtmlSourcecode = Nothing


End With

Debug.Print Timer - ttt
'debug
MsgBox For_Debug_Response, , "DEBUG"

End Sub


(因語法關係,改用圖片,請手動輸入,或參考附件)







'===================================


附加壓縮檔: 201808/mobile01-407074dc7525f3069a98a2b7368d142f.zip
snare wrote:
處理json集合字...(恕刪)



樓主 早安

今天執行程式出現下列兩個問題:

錯誤 438 「 物件不支援此屬性或方法 」
temp(1, 2) = CallByName(temparray, "z", VbGet)

應用程式或物件定義上的錯誤1004
Sheets(sheetsname).Range(check1 & ":" & check1 & "," & check2 & ":" & check2).Delete




謝謝您的教學

yuhuahsiao wrote:
錯誤 438 「 物件不支援此屬性或方法 」
temp(1, 2) = CallByName(temparray, "z", VbGet)
...(恕刪)


不知道您在問什麼170樓、219樓的程式沒出現這個錯誤

yuhuahsiao wrote:
應用程式或物件定義上的錯誤1004
Sheets(sheetsname).Range(check1 & ":" & check1 & "," & check2 & ":" & check2).Delete
...(恕刪)


因為當初網站的資料有留0080、0081,2個bug資料,所以下載後要刪除
現在bug修正了,所以這行程式會出錯

請試著自行修改
(不會改請回170樓、219樓,看內文)
snare wrote:
不知道您在問什麼170...(恕刪)


是219樓

請參考附圖1.看來是z沒出現.我是在早上0816執行

找到問題了

盤中10:08 更新 有z出現 附圖2

1.

2.



謝樓主

樓主好
股權結構表執行完出現空資料,查詢之後網址好像有更動,原先https://www.tdcc.com.tw/smWeb/QryStockAjax.do
出現空資料,不知如何更改程式,請教一下,謝謝
關閉廣告
文章分享
評分
評分
複製連結
請輸入您要前往的頁數(1 ~ 143)

今日熱門文章 網友點擊推薦!