返回列表 上一主題 發帖

[發問] 個股歷史價格表

[發問] 個股歷史價格表

鉅亨歷史價格表的網址原來是:
       "https://www.cnyes.com/twstock/ps_historyprice/2330.htm"
       且原來的參數為 "&ctl00$ContentPlaceHolder1$startText=" & StartDate 的格式

  現在已改變成為:
       "https://invest.cnyes.com/twstock/tws/2330/history"
請問如何更正能取得資料?

   Sub 鉅亨歷史K_Test()
    Dim sh As Worksheet
    Dim oXmlhttp As Object, oHtmldoc As Object
    Dim URL As String, E As Variant
    Dim StartDate$, EndDate$, submitBTN$, ttt#, tt#
    Dim a As Variant, Table As Object, Ar_Code()
    Dim oDOC As Object, Req$
    Dim Re%, Ce%, k%, n%, i%, dataLen%
    Dim stockno$
    Set sh = Sheets("試驗頁"): sh.Select
   
    stockno = "2330"
      StartDate = Format("2010/01/01", "yyyy-mm-dd")    '起始日期
      EndDate = Format(Date, "yyyy-mm-dd")
      StartDate = "jsx-197276814 date_start=" & StartDate   '(??)
      EndDate = "& jsx-197276814 date_end=" & EndDate   '(??)
      submitBTN = "& jsx-197276814 action_submit=套用"   '(??)
      Req = StartDate & EndDate & submitBTN                         '(??)
    i = 0: k = 0
    ttt = timer
   
    Set oXmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    Set oHtmldoc = CreateObject("htmlfile")

    Application.DisplayStatusBar = True
    DoEvents
     
    With oXmlhttp
            URL = "https://invest.cnyes.com/twstock/tws/" & stockno & "/history"
            .Open "POST", URL, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .setRequestHeader "Referer", URL
            .setRequestHeader "Cache-Control", "no-cache"
            .setRequestHeader "Pragma", "no-cache"
            .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
            .send Req
            
             tt = timer
            Do While .Status <> 200 And timer - tt < 3
                DoEvents
            Loop
''''           DoEvents
           
           '網頁未準備好,關閉重啟
            If .Status <> 200 Then
                Set oXmlhttp = Nothing
               
                Exit Sub
            End If

           oHtmldoc.write .responsetext

            Set E = oHtmldoc.all.tags("TABLE")(0)
            If E Is Nothing Then
                Debug.Print stockno & " E.Table = Null"
                Exit Sub
            End If
            
            dataLen = E.Rows.Length
            ReDim price(dataLen, 8)
                           
            For Re = 1 To dataLen - 1
                  price(Re, 1) = E.Rows(Re).Cells(0).innertext          '日期
                  For Ce = 1 To 7
                        If Ce = 6 Then
                        
                            '去除 %
                            price(Re, Ce + 1) = Val(Replace(E.Rows(Re).Cells(Ce).innertext, "%", ""))
                        Else
                        
                            '去除千分號,開、高、低、收、漲跌  漲% 成交量 ' 成交金額
                            price(Re, Ce + 1) = Val(Replace(E.Rows(Re).Cells(Ce).innertext, ",", ""))
                        End If
                        
                  Next
            Next
            
'''           Debug.Print timer - ttt

        
    End With
    Application.DisplayStatusBar = False
    Set oXmlhttp = Nothing
    Set oHtmldoc = Nothing
    Set E = Nothing
   
    [A1].Resize(dataLen, 8) = price
    Exit Sub   
   
End Sub

   謝謝

回復 2# joey0415

謝謝joey04152大 的指導
試著去做,有問題再請教。

TOP

回復 2# joey0415

  試作如下,請 joey0415 大參考斧正,謝謝:

  Option Base 1  
'myArr() 的欄位: 日期、開、高、低、收、漲、漲%、張數
'鉅亨資料列 :日期、開、高、低、收、張數
Sub 鉅亨歷史K_Test1()
      Dim stockno$, myTEXT, myText1
      Dim sh As Worksheet
      Dim T!, recCAT$, i%, j%, k%, n%, Trade%, BarCntReq%
      Dim myXML As Object, URL$, myArr
      Dim StartDate&, EndDate&
      Const Dat% = 1, Op% = 2, Hi% = 3, Low% = 4, Klose% = 5, CHG% = 6, CHGpercent% = 7, Vol% = 8    'for myArr
      
      StartDate = DateToUnixTime("2020/01/02")
      EndDate = DateToUnixTime(Format(Date, "yyyy/mm/dd"))
      Application.DisplayStatusBar = True
      Application.StatusBar = stockno & " 連網中... "
      Set myXML = CreateObject("WinHttp.WinHttpRequest.5.1")
      recCAT = "D"          '日線圖
      URL = "https://ws.api.cnyes.com/charting/api/v1/history?resolution=" & recCAT & "&symbol=TWS:2330:STOCK&from=" & EndDate & "&to=" & StartDate
      T = timer
      With myXML
          .Open "GET", URL, False
          .send
          Do While .Status <> 200
             DoEvents
             If timer - T > 3 Then Exit Do
          Loop
         
          myTEXT = .responsetext                '文字串 .txt
      End With
      
      Set myXML = Nothing
      If myTEXT = "" Then GoTo Exit_Sub
      myTEXT = Split(myTEXT, ":")
      
      myText1 = Split(Replace(Replace(myTEXT(5), "[", ""), "]", ""), ",")
      n = UBound(myText1): ReDim myArr(n + 1, 8)
      For i = 0 To UBound(myText1) - 1
          myArr(i + 1, 1) = UnixTime2Date(myText1(i))
      Next

          k = 4
      For j = 6 To 10         '開、高、低、收、張數
          myText1 = Split(myTEXT(j), ",")
          If j = 10 Then k = 2               '控制 myArr 的行數(column), 第8行是張數
          For i = 0 To n - 1
               myArr(i + 1, j - k) = myText1(i)
          Next
          myArr(1, j - k) = Replace(myArr(1, j - k), "[", ""): myArr(n, j - k) = Replace(myArr(n, j - k), "]", "")
      Next j
      For i = 1 To n - 1
          myArr(i, 6) = myArr(i, 5) - myArr(i + 1, 5): myArr(i, 7) = Format(myArr(i, 6) / myArr(i + 1, 5) * 100, "#0.00")    '漲跌、漲跌%
      Next
      
Exit_Sub:
      Set myXML = Nothing
      Application.StatusBar = ""
      Application.DisplayStatusBar = False

End Sub

Function DateToUnixTime(dstring) As Long
      DateToUnixTime = (DateValue(dstring) - #1/1/1970 8:00:00 AM#) * 86400
End Function

Function UnixTime2Date(UnixT) As Date
      UnixTime2Date = Format(UnixT / 86400 + #1/1/1970 8:00:00 AM#, "yyyy/mm/dd")
End Function

TOP

回復 1# Scott090

鉅亨歷史價格表的網址原來是:
       "https://www.cnyes.com/twstock/ps_historyprice/2330.htm"
   已改為: "https://www.cnyes.com/archive/twstock/ps_historyprice/2330.htm"
       且原來的參數為 "&ctl00$ContentPlaceHolder1$startText=" & StartDate 的格式一樣可用

  新版的網址在:
       "https://invest.cnyes.com/twstock/tws/2330/history"
     他的參數就不知如何做了?????

TOP

回復 6# GBKEE


    感恩 GBKEE 大
     我研究大作看看

TOP

回復 8# quickfixer


    mobile01 論壇嗎?
謝謝 quickfixer 大的訊息

TOP

本帖最後由 Scott090 於 2020-4-16 06:12 編輯

回復 8# quickfixer


    quickfixer 大:
    https://www.mobile01.com/topicde ... ;t=4737630&p=77
   很可惜,我沒找到。
    可否明示是第幾樓或他的 Xml json code

   謝謝

TOP

回復 11# quickfixer


    找到了,謝謝

TOP

        靜思自在 : 一個人的快樂.不是因為他擁有得多,而是因為他計較得少。
返回列表 上一主題