Board logo

標題: [發問] VBA自動抓取finance.yahoo [打印本頁]
作者: DanielWONG    時間: 2018-6-16 14:58     標題: 這個資料有辦法用VBA自動抓嗎？

:) 各位， 我想每天用VBA自動抓取下面連結的網站

https://www.hangseng.com/en-hk/e-services/e-mpf/fund-price-performance/price/

每天自動更新的基金價格資料。
比如，
Name of Constituent Fund        Bid Price (HKD)        Offer Price (HKD)
Age 65 Plus Fund                        11.57                                   11.57
想抓取 11.57 這個價格，  請問用什麼方法呢？

試了query table 和 解析HTML都不成功呀。 多謝指點迷津！:handshake

[attach]28847[/attach]
作者: iamaraymond    時間: 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
複製代碼
作者: iamaraymond    時間: 2018-6-16 15:55

回復 1# DanielWONG

執行結果應該如下圖
[attach]28848[/attach]

我看他還有蠻多資料可以用的
[attach]28849[/attach]
(但我不知道那些資料的用途，所以就沒加了XD)
如果需要的話可自行加在myStrArr裡
作者: DanielWONG    時間: 2018-6-16 17:04

回復 3# iamaraymond


    多謝大神， 我先消化一下您的方法！
作者: f3202    時間: 2018-6-16 17:46

回復 3# iamaraymond

請問
https://djinfo.cathaysec.com.tw/z/ze/zef/zef.djhtm
和   
http://justdata.yuanta.com.tw/z/ze/zeb/zeb.djhtm
這種下載後有部分隱藏下載不完全
該怎麼下載
謝謝
作者: DanielWONG    時間: 2018-6-16 19:27

回復 3# iamaraymond


   
感覺 .ResponseText 內容好多啊！
其實我不需要選擇日期，只需要抓當前日期 Chinese Equity Fund， Global Bond Fund和Hang Seng Index Tracking Fund 三種基金的當前價格。是否可能抓少一些東西讓.ResponseText內容少些呢？
作者: DanielWONG    時間: 2018-6-17 09:01     標題: VBA自動抓取finance.yahoo

各位，如用VBA XML.HTTP自動抓取下面連結的網站

https://hk.finance.yahoo.com/quote/0388.HK?p=0388.HK

每天自動更新的成交量資料。我不會尋找對應的URL， 哪位元可以幫忙提供開始部分到ResponseText的代碼嗎？ 感激！
[attach]28850[/attach]
作者: f3202    時間: 2018-6-17 10:36

回復 1# DanielWONG


    Sub 香港交易所_test()
Dim Stock1 As String
Dim oXmlhttp As Object, oHtmldoc As Object, surl As String, E As Object, R As Integer, C As Integer
  Set oXmlhttp = CreateObject("msxml2.xmlhttp")
   Set oHtmldoc = CreateObject("htmlfile")
     surl = "https://hk.finance.yahoo.com/quote/0388.HK"
        With oXmlhttp
        .Open "Get", surl, False
        .send
        oHtmldoc.Write .responseText
    End With
    ActiveSheet.Cells.Clear
     With oHtmldoc
        Set E = .all.tags("table")(1)
        For R = 0 To E.Rows.Length - 1
            For C = 0 To E.Rows(R).Cells.Length - 1
                ActiveSheet.Cells(R + 1, C + 1) = E.Rows(R).Cells(C).innerText
            Next
        Next
    End With
    End Sub
作者: iamaraymond    時間: 2018-6-17 15:06

回復 6# DanielWONG

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

至於只取那三檔基金的資料
我覺得比較有彈性的作法是在旁邊直接用vlookup函數
保持資料的完整性
以免日後若想要取其他基金的資料又要改一次程式
作者: iamaraymond    時間: 2018-6-17 15:06

回復 5# f3202

不好意思不是很了解你的意思
可以多說明一下嗎?
作者: f3202    時間: 2018-6-17 15:40

本帖最後由 f3202 於 2018-6-17 15:43 編輯

回復 8# iamaraymond
[attach]28853[/attach]
[attach]28854[/attach]
a99之後股名下載不到
謝謝
作者: DanielWONG    時間: 2018-6-17 17:50

回復 2# f3202


   Very  Nice code!  Thank you very much!
作者: DanielWONG    時間: 2018-6-17 20:17     標題: 请教这个指标可以用vba提取吗？

这里真是高手云集，以前一些以为没法用VBA提取的资料原来是可以的！那么请教下面这个网站的RSI数据可以用vba自动提取吗？ 谢谢！

http://www.aastocks.com/tc/stock/detailchart.aspx?symbol=110000#GTop

[attach]28856[/attach]
作者: iamaraymond    時間: 2018-6-18 10:28

回復 9# f3202

這應該可以使用您在另外一個帖子回的
http://forum.twbts.com/redirect. ... 3&fromuid=30076
xmlhttp+htmlfile來抓到
作者: f3202    時間: 2018-6-18 10:38

回復 10# iamaraymond

9樓的圖是那個程式下載加變碼的
謝謝
作者: iamaraymond    時間: 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
複製代碼
作者: f3202    時間: 2018-6-18 13:16

回復 12# iamaraymond

謝謝版大
第一個測試成功
第二個我研究看看
若有問題再請教版大
佳節愉快
作者: iamaraymond    時間: 2018-6-18 13:29

回復 13# f3202

OK，你可以先研究一下程式碼
看如何改成抓第二個網址的資料
這樣比較容易進步
若有問題都可以問喔~



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)