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

DanielWONG

:) 各位， 我想每天用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

下載 (66.6 KB)
example

2018-6-16 14:56

iamaraymond

回復 1# DanielWONG

試試看~

1. Sub test()
   
2. 
   
3. Cells.Clear
   
4. 
   
5. Dim myXML As Object
   
6. Set myXML = CreateObject("Winhttp.WinhttpRequest.5.1")
   
7. 
   
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

回復 1# DanielWONG

執行結果應該如下圖

下載 (128.14 KB)

2018-6-16 15:53

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

下載 (100.93 KB)

2018-6-16 15:55

(但我不知道那些資料的用途，所以就沒加了XD)
如果需要的話可自行加在myStrArr裡

DanielWONG

回復 3# iamaraymond


    多謝大神， 我先消化一下您的方法！

f3202

回復 3# iamaraymond

請問
https://djinfo.cathaysec.com.tw/z/ze/zef/zef.djhtm
和   
http://justdata.yuanta.com.tw/z/ze/zeb/zeb.djhtm
這種下載後有部分隱藏下載不完全
該怎麼下載
謝謝

DanielWONG

回復 3# iamaraymond


   
感覺 .ResponseText 內容好多啊！
其實我不需要選擇日期，只需要抓當前日期 Chinese Equity Fund， Global Bond Fund和Hang Seng Index Tracking Fund 三種基金的當前價格。是否可能抓少一些東西讓.ResponseText內容少些呢？

DanielWONG

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

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

每天自動更新的成交量資料。我不會尋找對應的URL， 哪位元可以幫忙提供開始部分到ResponseText的代碼嗎？ 感激！

下載 (72.34 KB)

2018-6-17 09:00

f3202

回復 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

回復 6# DanielWONG

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

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

iamaraymond

回復 5# f3202

不好意思不是很了解你的意思
可以多說明一下嗎?