- 帖子
- 219
- 主題
- 24
- 精華
- 0
- 積分
- 243
- 點名
- 0
- 作業系統
- Windows10
- 軟體版本
- Office2016
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2012-4-18
- 最後登錄
- 2022-2-7
 
|
本帖最後由 HSIEN6001 於 2014-11-21 00:18 編輯
回復 1# wahaha6666
也是參考GBKEE大大的Code
試試,有符合需求?!- Dim 網頁 As Object
- Sub 半自動()
- Dim i As Integer, K As Integer, ii, J
- Dim path As String
- path = "C:\Stock\"
- '程式第一次執行: 打開網頁,在網頁中手動選擇資料後 , 按[總行]or[選定分行] ; 有資料的,執行第2次下載後會自動關閉網頁
- '程式第二次執行: 讀取網頁資料到 Excel中. (有出現table資料表的,再按一次執行程式則會下載檔案至目標)
-
- 年度 = "103"
- 季期 = "3"
- 代號 = "2880"
-
-
- On Error GoTo RE網頁
- 1:
- If 網頁 Is Nothing Then
- Set 網頁 = CreateObject("InternetExplorer.Application")
- With 網頁
- .Visible = True
- .navigate "http://mops.twse.com.tw/mops/web/t164sb04?encodeURIComponent=1&step=1&firstin=ture&off=1&keyword4=&code1=&TYPEK2=&checkbtn=&queryName=co_id&TYPEK=all&isnew=false&co_id=" & 代號 & "&year=" & 年度 & "&season=" & 季期
- .Height = 500
- .Width = 1050
- End With
- Exit Sub
- End If
- If 網頁.Visible = False Then
- 網頁.Value = True
- Exit Sub
- End If
- '**********讀取網頁 資料 *******************
- Set A = 網頁.document.getElementsByTagName("table")
- With Workbooks.Add
- On Error Resume Next
- '************************
- ' For ii = 0 To A.Length - 1 '不知道table範圍在何處: 從0開始
- '************************
- For ii = 11 To A.Length - 1
- For i = 0 To A(ii).Rows.Length - 1
- K = K + 1
- For J = 0 To 8
- Cells(K, J + 1) = A(ii).Rows(i).Cells(J).innerText
- Next
- Next
- Next
- '
- If Dir(path & 代號 & ".xls") <> "" Then Kill (path & 代號 & ".xls")
- ActiveWorkbook.SaveAs Filename:=path & 代號 & ".xls"
- ActiveWindow.Close
- End With
- Set A = Nothing
- 網頁.Quit '打開的網頁,再次執行後會自動下載有table的資料,完成下載後,自動關閉已下載完成的IE網頁
- Exit Sub
- RE網頁:
- Set 網頁 = Nothing
- Resume 1
- End Sub
|
|
發表於 2014-11-20 23:47
| 
