Board logo

標題: [發問] 個股歷史價格表 [打印本頁]
作者: Scott090    時間: 2020-4-8 18:36     標題: 個股歷史價格表

鉅亨歷史價格表的網址原來是：
       "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

   謝謝
作者: joey0415    時間: 2020-4-8 22:09

回復 1# Scott090

https://ws.api.cnyes.com/charting/api/v1/history?resolution=D&symbol=TWS:2330:STOCK&from=1586390400&to=1428364800

上面的格式為JSON
from=1586390400&to=1428364800

紅字為timestamp
轉換範例網站
https://www.cadch.com/article/timestamp/index.php

VBA參考
http://white5168.blogspot.com/2017/03/unix-timestamp-excel-vba.html
作者: Scott090    時間: 2020-4-9 05:15

回復 2# joey0415

謝謝joey04152大 的指導
試著去做，有問題再請教。
作者: Scott090    時間: 2020-4-12 17:42

回復 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
作者: Scott090    時間: 2020-4-12 17:52

回復 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"
     他的參數就不知如何做了?????
作者: GBKEE    時間: 2020-4-14 18:24

本帖最後由 GBKEE 於 2020-4-14 18:27 編輯

回復 5# Scott090
請了解 網頁控制項內容
--https://invest.cnyes.com/twstock/tws/2330/history
  1. '****選擇時間區間的各按鈕   [ 網頁控制項內容]  ********
  2. '<button class="jsx-197276814 period_btn" data-period="1d">1日</button>
  3. '<button class="jsx-197276814 period_btn" data-period="5d">5日</button>
  4. '<button class="jsx-197276814 period_btn" data-period="3m">3月</button>
  5. '<button class="jsx-197276814 period_btn" data-period="6m">6月</button>
  6. '<button class="jsx-197276814 period_btn" data-period="thisYear">今年以來</button>
  7. '<button class="jsx-197276814 period_btn" data-period="1y">1年</button>
  8. '<button class="jsx-197276814 period_btn" data-period="5y">5年</button>
  9. '<button class="jsx-197276814 period_btn" data-period="10y">最大</button>
  10. '<button class="jsx-197276814 period_btn period_btn--active" data-period="3m">3月</button>
  11. '****選擇時間區間後按下 (套用) 的按鈕   [ 網頁控制項內容]  ********
  12. '<button class="jsx-197276814 action_submit">套用</button>
  13. ''****選擇時間區間後按下(套用)按鈕所顯示的日期      [ 網頁控制項內容]  ********
  14. '<span class=    "jsx-197276814 btn_txt">2020/04/09 - 2020/04/14</span></button>
  15. ''****網頁所顯示股票的名稱      [ 網頁控制項內容]  ********
  16. '<h2 class="jsx-969407034 jsx-1444699802 sub_title">台積電</h2>
複製代碼
讀取網頁資料的程式碼 複製在同一模組中
  1. Option Explicit
  2. Sub Ex_鉅亨網_歷史價格()
  3.     Dim e As Object, R As Double, C As Integer
  4.      檢查
  5.     Application.ScreenUpdating = False
  6.     With CreateObject("InternetExplorer.Application")
  7.       '  .Visible = True
  8.         .Navigate "https://invest.cnyes.com/twstock/tws/" & [B1] & "/history"
  9.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  10.         If InStr(.Document.BODY.INNERTEXT, "您想看的頁面不存在") Then
  11.             .Quit    ''**   您想看的頁面不存在
  12.             MsgBox [B1] & "  找不到 ??? ":             End
  13.         End If
  14.         For Each e In .Document.ALL.TAGS("BUTTON")               '**指定時間區間
  15.             If e.CLASSNAME = "jsx-197276814 period_btn" And e.INNERTEXT = [D1].Text Then e.Click:  Exit For
  16.         Next
  17.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  18.         For Each e In .Document.ALL.TAGS("BUTTON")               '**指定時間區間後按下(套用)鍵
  19.             If e.CLASSNAME = "jsx-197276814 action_submit" And e.INNERTEXT = "套用" Then e.Click: Exit For
  20.         Next
  21.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  22.         For Each e In .Document.ALL.TAGS("H2")                            '**顯示股票的名稱
  23.             If e.CLASSNAME = "jsx-969407034 jsx-1444699802 sub_title" Then Range("B2") = e.INNERTEXT:  Exit For
  24.         Next
  25.         For Each e In .Document.ALL.TAGS("SPAN")                       '**顯示所指定的時間區間
  26.             If e.CLASSNAME = "jsx-197276814 btn_txt" Then Range("D2") = e.INNERTEXT:  Exit For
  27.         Next
  28.         '*********************等候資料下載完成***********************************************
  29.         Do While .Busy Or .readyState <> 4 And .Document.ALL.TAGS("table")(0) Is Nothing: DoEvents: Loop
  30.         '********************資料內容導入工作表***********
  31.         With .Document.ALL.TAGS("table")(0)
  32.             For R = 0 To .Rows.Length - 1
  33.                 For C = 0 To .Rows(R).Cells.Length - 1
  34.                     Cells(R + 3, C + 1) = .Rows(R).Cells(C).INNERTEXT
  35.                 Next
  36.             Next
  37.         End With
  38.         .Quit     '*********關閉網頁
  39.     End With
  40.     [f1] = "***資料下載 完成***"
  41.    Exit Sub
  42. End Sub
  43. Private Sub 檢查()
  44.          ''**選擇時間區間-> Range("B2") 的處存格 導入[驗證資料]
  45.         With Range("D1").Validation
  46.             .Delete
  47.             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
  48.             xlBetween, Formula1:="1日,5日,3月,6月,今年以來,1年,5年,最大"   '
  49.         End With
  50.         If [B1] = "" Or [D1] = "" Then    '** Range("B2")  需是股票代號
  51.             MsgBox "股票號碼??  Or 時間區間 >>"
  52.              End         '***結束程式
  53.          End If
  54.         UsedRange.Offset(1).Clear
  55.       [f1] = "***資料下載中....***"
  56.       Application.ScreenUpdating = True
  57.       Application.Wait (Time + #12:00:01 AM#)
  58. End Sub
複製代碼
作者: Scott090    時間: 2020-4-15 05:32

回復 6# GBKEE


    感恩 GBKEE 大
     我研究大作看看
作者: quickfixer    時間: 2020-4-15 09:15

回復 7# Scott090

01那邊上星期就有cnyes的Xml json code
可以去看看
作者: Scott090    時間: 2020-4-15 12:26

回復 8# quickfixer


    mobile01 論壇嗎?
謝謝 quickfixer 大的訊息
作者: Scott090    時間: 2020-4-16 05:59

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

回復 8# quickfixer


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

   謝謝
作者: quickfixer    時間: 2020-4-16 06:17

回復 10# Scott090

01文書處理,某s的文章#75
標題沒更新,內容常常偷偷更新:L
作者: Scott090    時間: 2020-4-16 16:41

回復 11# quickfixer


    找到了，謝謝



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