返回列表 上一主題 發帖

[原創] 集保資料(改版後)

iamaraymond
　暱稱: Raymond Chien

中學生Rank: 2

帖子
109 
主題
12 
精華
0 
積分
177 
點名
0  
作業系統
win10 
軟體版本
office2013 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2017-11-19 
最後登錄
2023-7-5 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2018-3-27 11:21 | 顯示全部帖子

[原創] 集保資料(改版後)

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

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

個人不太喜歡IE法，所以用的是WinHttpRequest，速度快很多
  1. Sub test()

  3. Cells.Clear

  5. Dim myXML As Object
  6. Set myXML = CreateObject("WinHttp.WinHttpRequest.5.1")

  8. Dim myHTML As Object
  9. Set myHTML = CreateObject("HTMLFile")

  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

  55. End Sub
複製代碼
收藏 分享
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

iamaraymond
　暱稱: Raymond Chien

中學生Rank: 2

帖子
109 
主題
12 
精華
0 
積分
177 
點名
0  
作業系統
win10 
軟體版本
office2013 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2017-11-19 
最後登錄
2023-7-5 
2#
發表於 2018-3-28 09:58 | 顯示全部帖子
回復 2# joey0415

感謝你的分享，您提供的網站真的很棒，只是小弟真的很缺乏每周都去抓資料的毅力XD
QueryTable也不錯，因為這個網站資料較少，所以可以執行很快，但如果碰到很龐大的資料時可能就會跑很久，所以不知不覺就養成用XMLHTTP抓資料的習慣了
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

iamaraymond
　暱稱: Raymond Chien

中學生Rank: 2

帖子
109 
主題
12 
精華
0 
積分
177 
點名
0  
作業系統
win10 
軟體版本
office2013 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2017-11-19 
最後登錄
2023-7-5 
3#
發表於 2018-3-28 10:04 | 顯示全部帖子
回復 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用變數取代，記得字串跟變數要用&連接
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

iamaraymond
　暱稱: Raymond Chien

中學生Rank: 2

帖子
109 
主題
12 
精華
0 
積分
177 
點名
0  
作業系統
win10 
軟體版本
office2013 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2017-11-19 
最後登錄
2023-7-5 
4#
發表於 2018-3-28 21:51 | 顯示全部帖子
回復 9# bhsm
  1. Sub test()

  3. stockno = InputBox("請輸入股票代號")
  4. If stockno = "" Then Exit Sub
  5. Application.ScreenUpdating = False
  6. [A4].CurrentRegion.Clear

  8. t = Timer

  10. Dim myXML As Object
  11. Set myXML = CreateObject("WinHttp.WinHttpRequest.5.1")

  13. Dim myHTML As Object
  14. Set myHTML = CreateObject("HTMLFile")

  16. myLimit = 10 '近幾筆資料數

  18. ReDim myDateArr(1 To 60, 1 To 1)
  19. ReDim myValArr(1 To 25, 1 To myLimit * 5)

  21. With myXML
  22.     .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False    '先抓取日期
  23.     .setRequestHeader "Content-type", "application/x-www-form-urlencoded;charset=UTF-8"
  24.     .send "REQ_OPR=qrySelScaDates"
  25.    
  26.     k = 1
  27.     For Each myText2 In Split(.responseText, ",")
  28.         myDateArr(k, 1) = Replace(Replace(Replace(myText2, Chr(34), ""), "[", ""), "]", "")
  29.         k = k + 1
  30.     Next
  31.    
  32.     mycount = 1
  33.     For Each myDate In myDateArr
  34. retry:
  35.         .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False    '代入日期撈資料
  36.         .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
  37.         .send "scaDates=" & myDate & "&scaDate=" & myDate & "&SqlMethod=StockNo&StockNo=" & stockno & "&StockName=&REQ_OPR=SELECT&clkStockNo=" & stockno & "&clkStockName="
  38.         
  39.         If InStr(1, .responseText, "無此資料") <> 0 Then GoTo retry
  40.         
  41.         myHTML.body.innerHTML = .responseText
  42.         
  43.         Set mytable = myHTML.getElementsByTagName("table")(7)
  44.         
  45.         i = 1
  46.         
  47.         For Each myRow In mytable.Rows
  48.             
  49.              j = 5 * (myLimit - mycount) + 1
  50.             For Each myCell In myRow.Cells
  51.                 myValArr(i, j) = myCell.innerText
  52.                 j = j + 1
  53.             Next
  54.             i = i + 1
  55.         Next
  56.         Cells(4, j - 5) = myDate
  57.         Debug.Assert Cells(4, j - 4) = ""
  58.         mycount = mycount + 1
  59.         If mycount = myLimit + 1 Then Exit For '要抓幾筆資料
  60.     Next
  61. [A3] = "證券名稱：" & Split(Split(.responseText, "證券名稱：")(1), "<")(0)
  62. [A5].Resize(UBound(myValArr), 5 * myLimit).Value = myValArr

  64. End With

  66. Erase myDateArr
  67. Erase myValArr
  68. Set myXML = Nothing
  69. Set myHTML = Nothing

  71. Debug.Print Format(Timer - t, "0.00秒")
  72. Application.ScreenUpdating = True
  73. End Sub
複製代碼
試看看這個吧~
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

iamaraymond
　暱稱: Raymond Chien

中學生Rank: 2

帖子
109 
主題
12 
精華
0 
積分
177 
點名
0  
作業系統
win10 
軟體版本
office2013 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2017-11-19 
最後登錄
2023-7-5 
5#
發表於 2018-3-28 21:55 | 顯示全部帖子
本帖最後由 iamaraymond 於 2018-3-28 22:02 編輯

回復 10# quickfixer

這個文之前我也有看過，Snare大的程式當然比我這種門外漢強很多XD
只是我比較習慣把每一周都列出來，所以若您有興趣的話可以看看我剛剛新放上去的貼文
至於速度在其他條件差不多的情況下，主要是取決於發了多少Request，在他的code中只抓了2個禮拜的資料，但我抓了10個禮拜的，所以速度會比較慢
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

iamaraymond
　暱稱: Raymond Chien

中學生Rank: 2

帖子
109 
主題
12 
精華
0 
積分
177 
點名
0  
作業系統
win10 
軟體版本
office2013 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2017-11-19 
最後登錄
2023-7-5 
6#
發表於 2018-3-28 21:59 | 顯示全部帖子
回復 7# cji3cj6xu6


問題1:我剛剛新上傳了Code，可以參考看看
問題2:因為我沒遇到這個狀況，所以不確定

至於要跳著抓其實方法很多，例如用if設定計數器0和1，當等於1時才抓
或是判斷L是不是偶數之類的
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

iamaraymond
　暱稱: Raymond Chien

中學生Rank: 2

帖子
109 
主題
12 
精華
0 
積分
177 
點名
0  
作業系統
win10 
軟體版本
office2013 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2017-11-19 
最後登錄
2023-7-5 
7#
發表於 2018-3-28 22:19 | 顯示全部帖子
本帖最後由 iamaraymond 於 2018-3-28 22:21 編輯

回復 14# quickfixer

你們的錯誤是不是"安全通道支援發生錯誤 "?
如果是的話，我之前好像有看到有個解決方法是
打開註冊表(搜尋regedit)
   

然後依據電腦情況
(for Windows 7 64 bits)
[HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Internet Settings\WinHttp]
"DefaultSecureProtocols"=dword:00000a00

(for Windows 7 32 bits)
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\WinHttp]
"DefaultSecureProtocols"=dword:00000a00

參考看看

增加速度還有個方法是用陣列，速度真的差很多，原本要跑3,4秒的東西都只要0.X秒就好了XD
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

        靜思自在 : 太陽光大、父母恩大、君子量大，小人氣大。
返回列表 上一主題