返回列表 上一主題 發帖

[發問] 網路CSV下載問題

本帖最後由 spermbank 於 2013-3-30 00:58 編輯

回復 2# GBKEE


    損益表上市及上櫃可以耶,十分感謝大大
    另外我把網址改成http://mops.twse.com.tw/mops/web/t51sb13 讀取合併損益表  
    我發現卻又不行囉,不知道要如何修該?
    若網路資料會陸續增加筆數,是否需要自行更新判斷筆數呢?
    謝謝

TOP

RE: 網路CSV下載問題

回復 1# spermbank
這原始檔案中找不到CSV檔案的網址可下載!!
試試看 (可試著修改下載上市,上櫃的資料)
  1. Option Explicit
  2. Sub 公開資訊觀測站()
  3.     Dim Ie As Object, xx, k, j, i, AA As Variant
  4.     Dim T As Date
  5.     ActiveSheet.Cells.Clear
  6.      Application.DisplayStatusBar = True
  7.     On Error GoTo ie_err
  8.     Set Ie = CreateObject("InternetExplorer.Application")
  9.     Ie.Navigate "http://mops.twse.com.tw/mops/web/t51sb08"
  10.     Ie.Visible = True
  11.     Do While Ie.Busy Or Ie.ReadyState <> 4: DoEvents: Loop
  12.     '**********  修改這裡 的選項
  13.     Ie.Document.ALL(632).Value = "sii"   '上市 = sii,上櫃 = otc,興櫃 = rotc,公開發行 = pub
  14.     Ie.Document.ALL(643).Value = "101"   '年度
  15.     Ie.Document.ALL(650).Value = "04"    '第一季 = 01,第二季 = 02,第三季 = 03,第四季 = 04
  16.     Ie.Document.ALL(667).Click
  17.    
  18.     Ie.Visible = False
  19.     網頁整理
  20.     Set AA = Ie.Document.getelementsbytagname("table")   '資料區
  21.    ' Ie.Quit
  22.     T = Time
  23.     Application.ScreenUpdating = False
  24.     With ActiveSheet
  25.         On Error Resume Next
  26.         For xx = 13 To AA.Length - 1
  27.             For i = 0 To AA(xx).Rows.Length - 1      '寫入資料
  28.                 k = k + 1
  29.                 For j = 0 To 19
  30.                     .Cells(k, 1).Select
  31.                     Application.StatusBar = "下載資料中 ..." & k - 1
  32.                     .Cells(k, j + 1) = AA(xx).Rows(i).Cells(j).innertext
  33.                 Next
  34.             Next
  35.         Next
  36.         Set AA = .Range("S2:S" & .[S2].End(xlDown).Row)
  37.         AA.Replace "基本每股盈餘", "", xlWhole
  38.         AA.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  39.         .Cells(.Rows.Count, 1).End(xlUp).EntireRow.Delete
  40.          ActiveWindow.ScrollRow = .Cells(.Rows.Count, 1).End(xlUp).Row - 20
  41.         .Cells(.Rows.Count, 1).End(xlUp).Select
  42.     End With
  43.     Application.ScreenUpdating = True
  44.     'Ie.Quit
  45.     Application.StatusBar = "下載資料時間 : " & Format(Time - T, ["S秒"])
  46.     End
  47. ie_err:
  48.     MsgBox "網頁有問題,請重新執行..."
  49.     Set Ie = Nothing
  50. End Sub
  51. Private Sub 網頁整理()   '等待網頁下載資料完畢的時間
  52.     Dim Tt(1 To 3) As Date
  53.     Tt(1) = Time
  54.     Tt(2) = Time
  55.     Tt(3) = #12:00:10 AM#     '10秒 調整這裡
  56.     Do
  57.         If Time > Tt(2) Then
  58.             Application.StatusBar = "網頁下載中 剩餘秒數.. " & Second(Tt(1) + Tt(3) - Time)
  59.             Tt(2) = Time
  60.         End If
  61.         DoEvents
  62.     Loop Until Time > Tt(1) + Tt(3)
  63.     Application.StatusBar = "資料下載中...."
  64. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 有心就有福,有願就有力,自造福田,自得福緣。
返回列表 上一主題