[原創] 集保資料(改版後) 集保, 爬蟲, 股票

iamaraymond

最近集保網站改版，因此寫了此程式，但只是粗略地把資料抓下來，沒有多加整理

若有幫助到您，希望您在下方留個言讓我知道喔:loveliness:

個人不太喜歡IE法，所以用的是WinHttpRequest，速度快很多

1. Sub test()
   
2. 
   
3. Cells.Clear
   
4. 
   
5. Dim myXML As Object
   
6. Set myXML = CreateObject("WinHttp.WinHttpRequest.5.1")
   
7. 
   
8. Dim myHTML As Object
   
9. Set myHTML = CreateObject("HTMLFile")
   
10. 
    
11. With myXML
    
12.     .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False    '先抓取日期
    
13.     .setRequestHeader "Content-type", "application/x-www-form-urlencoded;charset=UTF-8"
    
14.     .send "REQ_OPR=qrySelScaDates"
    
15.    
    
16.     myText = .responseText
    
17.     myText1 = Split(myText, ",")
    
18.     k = 1
    
19.     For Each myText2 In myText1
    
20.         Cells(1, k) = Replace(myText2, Chr(34), "")
    
21.         Cells(1, k) = Replace(Cells(1, k), "[", "")
    
22.         Cells(1, k) = Replace(Cells(1, k), "]", "")
    
23.         k = k + 1
    
24.     Next
    
25.    
    
26.     i = 6
    
27.    
    
28.     For Each myDate In Range("A1:BH1").Value
    
29.         
    
30.         .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False    '代入日期撈資料
    
31.         .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
    
32.         .send "scaDates=" & myDate & "&scaDate=" & myDate & "&SqlMethod=StockNo&StockNo=2330&StockName=&REQ_OPR=SELECT&clkStockNo=2330&clkStockName="
    
33.       
    
34.         myHTML.body.innerHTML = .responseText
    
35.    
    
36.         Set myTable = myHTML.getElementsByTagName("table")(7)
    
37.         
    
38.         For Each myRow In myTable.Rows
    
39.             j = 1
    
40.             For Each myCell In myRow.Cells
    
41.                 Cells(i, j) = myCell.innerText
    
42.                 j = j + 1
    
43.             Next
    
44.             i = i + 1
    
45.         Next
    
46.         i = i + 5
    
47.         L = L + 1
    
48.         If L > 10 Then Exit For '要抓幾筆資料
    
49.     Next
    
50.    
    
51. End With
    
52. Set myXML = Nothing
    
53. Set myHTML = Nothing
    
54. 
    
55. End Sub

複製代碼

joey0415

回復 1# iamaraymond

感謝您的分享，自己星期天也花點時間改程式，先找日期後，再使用query table方式抓取，您的方式也不錯

提供一個方向

https://data.gov.tw/dataset/11452

這裏提供每週所有股票一起下載，不過要每週抓取，沒有以前的資料，如果不急的話，用這個網站累積自己的資料庫才是最棒的，每星期只抓一次

cji3cj6xu6

有看到了，謝謝!!

但請問一下要如何修改股票代號為變數??

iamaraymond

回復 2# joey0415

感謝你的分享，您提供的網站真的很棒，只是小弟真的很缺乏每周都去抓資料的毅力XD
QueryTable也不錯，因為這個網站資料較少，所以可以執行很快，但如果碰到很龐大的資料時可能就會跑很久，所以不知不覺就養成用XMLHTTP抓資料的習慣了

iamaraymond

回復 3# cji3cj6xu6


例如說可以在B3儲存格輸入股票代號，然後指定給變數，長這樣
stockno=[B3]
或是用inputbox
stockno=inputbox("請輸入股票代號")

接著把原程式碼的第32行改成
.send "scaDates=" & myDate & "&scaDate=" & myDate & "&SqlMethod=StockNo&StockNo=" & stockno & "&StockName=&REQ_OPR=SELECT&clkStockNo=" & stockno & "&clkStockName="
把原本的2330用變數取代，記得字串跟變數要用&連接

cji3cj6xu6

萬分感謝~~

cji3cj6xu6

Dear iamaraymond 大，

有看到兩個問題，不曉得其他人是否也遇到:
1.  日期的部分你抓下來後放在A1, B1, C1.......，並不是放在每份資料的上方，不過瑕不掩瑜，看一下就懂了。
2.  當按下 Run後，會出現執行階段錯誤訊息並指向於 (.send "REQ_OPR=qrySelScaDates")，於是我在開頭的位置寫入了 On Error Resume Next ，之後就正常了，不曉得會有後遺症嗎?

還有個小問題想問一下，
請問我想跳著抓資料，例如:兩星期抓一筆，不曉得要修改哪裡?若有空，再請指導一下。謝謝~~

cji3cj6xu6

Dear iamaraymond 大，

Sorry， 我仔細看了一下，我大概知道該如何修改成我要的東西了。
麻煩您了~~

bhsm

回復 5# iamaraymond
請教iamaraymond大:如何把抓下來的日期放在每份資料的上方,而不是放在A1, B1, C1.......,謝謝

quickfixer

我認為這邊的程式完成度較高
而且更新程式非常的快,時間比樓主還早幾天
可惜沒什麼人看
https://www.mobile01.com/topicdetail.php?f=511&t=4737630