如何輸入網址直接下載CSV

jerrystock

請問網址
http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU_d.php
http://www.otc.org.tw/web/stock/aftertrading/peratio_analysis/pera.php?l=zh-tw
如何在網址列輸入URL直接下載CSV的檔案   不需要去點另存CSV
謝謝

GBKEE

回復 1# jerrystock
只找到 個股本益比 的網址參數
http://www.otc.org.tw/web/stock/ ... ?d=103/10/07&c=

試試看

1. Option Explicit
   
2. Const 本益比 = "http://www.otc.org.tw/web/stock/aftertrading/peratio_analysis/pera.php"
   
3. Const 本益比download = "http://www.otc.org.tw/web/stock/aftertrading/peratio_analysis/pera_download.php?d="
   
4. Dim xDate As Date, Stk As String
   
5. Private Sub 個股本益比_殖利率及股價淨值比_依日期查詢()
   
6.     Dim s As String, E As Variant, A
   
7.     xDate = Date - 1
   
8.     Do Until Weekday(xDate, vbFriday) < 6
   
9.         xDate = xDate - 1
   
10.     Loop
    
11.     With CreateObject("InternetExplorer.Application")
    
12.         .Visible = True
    
13.        .Navigate 本益比
    
14.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
    
15.         With .document
    
16.             '資料日期：<input id="input_date" name="input_date" class="input-date ui-corner-all" onchange="query()" maxlength="6">
    
17.             .ALL("input_date").Value = Format(xDate, "E/MM/DD")  '
    
18.             'D = .ALL("input_date").Value
    
19.             '產業類別：<select id="stk_category" class="input-stk-cat ui-corner-all" onchange="query()">
    
20.             .ALL("stk_category").Item(0).Selected = True '全部
    
21.             '.ALL("stk_category").Item(8).Selected = True '第 9(0 -> 8) 項
    
22.             Stk = .ALL("stk_category").Value
    
23.            ' .ALL("stk_category").fireEvent ("onchange")
    
24.             With .ALL("stk_category")
    
25.                 For E = 0 To .Length - 1
    
26.                     If .Item(E).Value = .Value Then Stk = .Item(E).Value & " " & .Item(E).INNERTEXT
    
27.                     s = IIf(s = "", .Item(E).Value & " " & .Item(E).INNERTEXT, s & vbLf & .Item(E).Value & " " & .Item(E).INNERTEXT)
    
28.                 Next
    
29.             End With
    
30.         End With
    
31.         MsgBox "你選擇:  " & Stk & vbLf & vbLf & s, , "產業類別"
    
32.         .Quit
    
33.     End With
    
34.     載入CSV
    
35. End Sub
    
36. Private Sub 載入CSV()
    
37.     Dim xml As Object     '用來取得網頁資料
    
38.     Dim stream            '用來儲存二進位檔案
    
39.     Dim URL As String     '目的網址
    
40.     Dim xPath As String, xfile As String, W As Workbook
    
41.     xPath = "d:\"         '指定存檔路徑
    
42.     xfile = xPath & Replace(Format(xDate, "E/MM/DD"), "/", "_") & " " & Split(Stk, " ")(1) & ".csv"
    
43.     For Each W In Workbooks
    
44.         If UCase(W.FullName) = UCase(xfile) Then W.Close: Exit For
    
45.     Next
    
46.     Set xml = CreateObject("Microsoft.XMLHTTP")
    
47.     Set stream = CreateObject("ADODB.stream")
    
48.     URL = 本益比download & Format(xDate, "E/MM/DD") & "&c=" & Split(Stk, " ")(0)
    
49.         xml.Open "POST", URL, 0
    
50.         xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
51.         xml.send
    
52.     With stream
    
53.         .Open
    
54.         .Type = 1
    
55.         .write xml.ResponseBody
    
56.         If Dir(xfile) <> "" Then Kill xfile
    
57.         .SaveToFile (xfile)
    
58.         .Close
    
59.     End With
    
60.     With Workbooks.Open(xfile).Sheets(1)
    
61.         If .Range("A5") = "共0筆" Then
    
62.             .Parent.Close
    
63.             Kill xfile
    
64.             MsgBox xDate & " - " & Stk & " 沒有資料"
    
65.         Else
    
66.             MsgBox xDate & " - " & Stk & Space(5) & .Cells(1).End(xlDown) & "資料"
    
67.         End If
    
68.     End With
    
69. End Sub

複製代碼

jerrystock

回復 2# GBKEE
感謝GBKEE大大百忙中抽空回覆小弟的愚問
也解決了我的問題  謝謝您^^