返回列表 上一主題 發帖

[發問] VBA自動抓取finance.yahoo

iamaraymond
　暱稱: Raymond Chien

中學生Rank: 2

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

試試看~
  1. Sub test()

  3. Cells.Clear

  5. Dim myXML As Object
  6. Set myXML = CreateObject("Winhttp.WinhttpRequest.5.1")

  8. With myXML
  9.     .Open "POST", "https://rbwm-api.hsbc.com.hk/pws-hk-hase-mpfunitprice-papi-prod-proxy/v1/mpf/getSuperTrustPlus", False
  10.     .setRequestHeader "content-type", "application/json;charset=UTF-8"
  11.     body = "{""locale"":""en""}"
  12.     .send body
  13.    
  14.     myText1 = .responseText
  15.     myText2 = Split(myText1, """trustPlusList"":[{""")(1)
  16.     j = 1
  17.     myStrArr = Array("FUND_NAME", "UNIT_PRICE_DATE", "FUND_CURRENCY", "ASK_PRICE", "BID_PRICE")
  18.     For Each myStr In myStrArr
  19.         myText3 = Split(myText2, myStr)
  20.         For i = 1 To UBound(myText3)
  21.             Cells(i + 1, j) = Replace(Replace(Split(myText3(i), ",")(0), ":", ""), Chr(34), "")
  22.         Next
  23.         j = j + 1
  24.     Next
  25.     Range("A1").Resize(1, UBound(myStrArr) + 1).Value = myStrArr
  26.     'Debug.Print .responseText
  27. End With
  28. Set myXML = Nothing
  29. 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 
2#
發表於 2018-6-16 15:55 | 顯示全部帖子
回復 1# DanielWONG

執行結果應該如下圖


我看他還有蠻多資料可以用的

(但我不知道那些資料的用途，所以就沒加了XD)
如果需要的話可自行加在myStrArr裡
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-6-17 15:06 | 顯示全部帖子
回復 6# DanielWONG

如果不需要日期的話，只要改一下myStrArr就好
myStrArr = Array("FUND_NAME", "FUND_CURRENCY", "ASK_PRICE", "BID_PRICE")

至於只取那三檔基金的資料
我覺得比較有彈性的作法是在旁邊直接用vlookup函數
保持資料的完整性
以免日後若想要取其他基金的資料又要改一次程式
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-6-17 15:06 | 顯示全部帖子
回復 5# f3202

不好意思不是很了解你的意思
可以多說明一下嗎?
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-6-18 10:28 | 顯示全部帖子
回復 9# f3202

這應該可以使用您在另外一個帖子回的
http://forum.twbts.com/redirect. ... 3&fromuid=30076
xmlhttp+htmlfile來抓到
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-6-18 12:49 | 顯示全部帖子
回復 11# f3202

試試看
  1. Sub test()

  3. Dim t: t = Timer

  5. Cells.Clear

  7. Dim myXML As Object
  8. Set myXML = CreateObject("Microsoft.XMLHTTP")

  10. Dim myHTML As Object
  11. Set myHTML = CreateObject("HTMLFile")

  13. With myXML
  14.     .Open "GET", "https://djinfo.cathaysec.com.tw/z/ze/zef/zef.djhtm", False
  15.     .send
  16.    
  17.     myHTML.body.innerHTML = convertraw(.responseBody)
  18.     Set myTrs = myHTML.getElementsByTagName("table")(2).getElementsByTagName("tbody")(0).getElementsByTagName("tr")
  19.     ReDim myArr(1 To myTrs.Length + 1, 1 To 4)
  20.     i = 1
  21.     For Each myTr In myTrs
  22.         Set myTds = myTr.getElementsByTagName("td")
  23.         j = 1
  24.         For Each myTd In myTds
  25.             myArr(i, j) = myTd.innerText
  26.             If myTd.innerText = "" Then
  27.                 myArr(i, j) = Right(Split(Split(Split(myTd.innerHTML, "GenLink2stk(")(1), "')")(0), "'")(1), 4) & Split(Split(Split(myTd.innerHTML, "GenLink2stk(")(1), "')")(0), "'")(3)
  28.             End If
  29.             j = j + 1
  30.         Next
  31.         i = i + 1
  32.     Next
  33.    
  34. End With
  35. Range("A1").Resize(UBound(myArr, 1), 4).Value = myArr
  36. Range("A1").WrapText = False
  37. Set myXML = Nothing
  38. Application.StatusBar = "抓取完畢，共花費" & Format(Timer - t, "0.00秒")

  40. End Sub
  41. Function convertraw(rawdata)

  43. Dim rawstr
  44. Set rawstr = CreateObject("adodb.stream")
  45. With rawstr
  46. .Type = 1
  47. .Mode = 3
  48. .Open
  49. .Write rawdata
  50. .Position = 0
  51. .Type = 2
  52. '繁體通常轉成big5就可以了，簡體通常是gb2312
  53. .Charset = "big5"
  54. convertraw = .ReadText
  55. .Close
  56. End With
  57. Set rawstr = Nothing

  59. End Function
複製代碼
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-6-18 13:29 | 顯示全部帖子
回復 13# f3202

OK，你可以先研究一下程式碼
看如何改成抓第二個網址的資料
這樣比較容易進步
若有問題都可以問喔~
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

        靜思自在 : 犯錯出懺悔心，才能清淨無煩惱。
返回列表 上一主題