- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2013-3-29 20:14
| 只看該作者
RE: 網路CSV下載問題
回復 1# spermbank
這原始檔案中找不到CSV檔案的網址可下載!!
試試看 (可試著修改下載上市,上櫃的資料)- Option Explicit
- Sub 公開資訊觀測站()
- Dim Ie As Object, xx, k, j, i, AA As Variant
- Dim T As Date
- ActiveSheet.Cells.Clear
- Application.DisplayStatusBar = True
- On Error GoTo ie_err
- Set Ie = CreateObject("InternetExplorer.Application")
- Ie.Navigate "http://mops.twse.com.tw/mops/web/t51sb08"
- Ie.Visible = True
- Do While Ie.Busy Or Ie.ReadyState <> 4: DoEvents: Loop
- '********** 修改這裡 的選項
- Ie.Document.ALL(632).Value = "sii" '上市 = sii,上櫃 = otc,興櫃 = rotc,公開發行 = pub
- Ie.Document.ALL(643).Value = "101" '年度
- Ie.Document.ALL(650).Value = "04" '第一季 = 01,第二季 = 02,第三季 = 03,第四季 = 04
- Ie.Document.ALL(667).Click
-
- Ie.Visible = False
- 網頁整理
- Set AA = Ie.Document.getelementsbytagname("table") '資料區
- ' Ie.Quit
- T = Time
- Application.ScreenUpdating = False
- With ActiveSheet
- On Error Resume Next
- For xx = 13 To AA.Length - 1
- For i = 0 To AA(xx).Rows.Length - 1 '寫入資料
- k = k + 1
- For j = 0 To 19
- .Cells(k, 1).Select
- Application.StatusBar = "下載資料中 ..." & k - 1
- .Cells(k, j + 1) = AA(xx).Rows(i).Cells(j).innertext
- Next
- Next
- Next
- Set AA = .Range("S2:S" & .[S2].End(xlDown).Row)
- AA.Replace "基本每股盈餘", "", xlWhole
- AA.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
- .Cells(.Rows.Count, 1).End(xlUp).EntireRow.Delete
- ActiveWindow.ScrollRow = .Cells(.Rows.Count, 1).End(xlUp).Row - 20
- .Cells(.Rows.Count, 1).End(xlUp).Select
- End With
- Application.ScreenUpdating = True
- 'Ie.Quit
- Application.StatusBar = "下載資料時間 : " & Format(Time - T, ["S秒"])
- End
- ie_err:
- MsgBox "網頁有問題,請重新執行..."
- Set Ie = Nothing
- End Sub
- Private Sub 網頁整理() '等待網頁下載資料完畢的時間
- Dim Tt(1 To 3) As Date
- Tt(1) = Time
- Tt(2) = Time
- Tt(3) = #12:00:10 AM# '10秒 調整這裡
- Do
- If Time > Tt(2) Then
- Application.StatusBar = "網頁下載中 剩餘秒數.. " & Second(Tt(1) + Tt(3) - Time)
- Tt(2) = Time
- End If
- DoEvents
- Loop Until Time > Tt(1) + Tt(3)
- Application.StatusBar = "資料下載中...."
- End Sub
複製代碼 |
|