- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2014-10-8 09:42
| 只看該作者
回復 1# jerrystock
只找到 個股本益比 的網址參數
http://www.otc.org.tw/web/stock/ ... ?d=103/10/07&c=
試試看- Option Explicit
- Const 本益比 = "http://www.otc.org.tw/web/stock/aftertrading/peratio_analysis/pera.php"
- Const 本益比download = "http://www.otc.org.tw/web/stock/aftertrading/peratio_analysis/pera_download.php?d="
- Dim xDate As Date, Stk As String
- Private Sub 個股本益比_殖利率及股價淨值比_依日期查詢()
- Dim s As String, E As Variant, A
- xDate = Date - 1
- Do Until Weekday(xDate, vbFriday) < 6
- xDate = xDate - 1
- Loop
- With CreateObject("InternetExplorer.Application")
- .Visible = True
- .Navigate 本益比
- Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
- With .document
- '資料日期：<input id="input_date" name="input_date" class="input-date ui-corner-all" onchange="query()" maxlength="6">
- .ALL("input_date").Value = Format(xDate, "E/MM/DD") '
- 'D = .ALL("input_date").Value
- '產業類別：<select id="stk_category" class="input-stk-cat ui-corner-all" onchange="query()">
- .ALL("stk_category").Item(0).Selected = True '全部
- '.ALL("stk_category").Item(8).Selected = True '第 9(0 -> 8) 項
- Stk = .ALL("stk_category").Value
- ' .ALL("stk_category").fireEvent ("onchange")
- With .ALL("stk_category")
- For E = 0 To .Length - 1
- If .Item(E).Value = .Value Then Stk = .Item(E).Value & " " & .Item(E).INNERTEXT
- s = IIf(s = "", .Item(E).Value & " " & .Item(E).INNERTEXT, s & vbLf & .Item(E).Value & " " & .Item(E).INNERTEXT)
- Next
- End With
- End With
- MsgBox "你選擇: " & Stk & vbLf & vbLf & s, , "產業類別"
- .Quit
- End With
- 載入CSV
- End Sub
- Private Sub 載入CSV()
- Dim xml As Object '用來取得網頁資料
- Dim stream '用來儲存二進位檔案
- Dim URL As String '目的網址
- Dim xPath As String, xfile As String, W As Workbook
- xPath = "d:\" '指定存檔路徑
- xfile = xPath & Replace(Format(xDate, "E/MM/DD"), "/", "_") & " " & Split(Stk, " ")(1) & ".csv"
- For Each W In Workbooks
- If UCase(W.FullName) = UCase(xfile) Then W.Close: Exit For
- Next
- Set xml = CreateObject("Microsoft.XMLHTTP")
- Set stream = CreateObject("ADODB.stream")
- URL = 本益比download & Format(xDate, "E/MM/DD") & "&c=" & Split(Stk, " ")(0)
- xml.Open "POST", URL, 0
- xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- xml.send
- With stream
- .Open
- .Type = 1
- .write xml.ResponseBody
- If Dir(xfile) <> "" Then Kill xfile
- .SaveToFile (xfile)
- .Close
- End With
- With Workbooks.Open(xfile).Sheets(1)
- If .Range("A5") = "共0筆" Then
- .Parent.Close
- Kill xfile
- MsgBox xDate & " - " & Stk & " 沒有資料"
- Else
- MsgBox xDate & " - " & Stk & Space(5) & .Cells(1).End(xlDown) & "資料"
- End If
- End With
- End Sub
|
|
發表於 2014-10-3 21:18
| 
