- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2013-9-3 07:21 編輯
回復 3# gelai01000001 - Option Explicit
- Sub 下載網站資料()
- Dim Startmonth As String, Startday As String, xDate As Date, Msg As Boolean, Sh As Worksheet
- Dim T As Date
- T = Time
- On Error Resume Next '程式執行中有錯誤時,不裡會繼續執行程式
- xDate = Date '當日
- '***************測試用
- xDate = #9/8/2013# '休市日
- '***************測試無誤後可刪除掉
- Set Sh = ActiveSheet '指定工作表:此程式在任何模組中皆可用
- EX:
- If Err.Number <> 0 Or Msg = True Then '當日(尚未有資料:錯誤) 或 休市
- xDate = xDate - 1 '往後退一日
- Err.Clear
- Msg = False
- End If
- Sh.UsedRange.Clear '清理工作表已使用的範圍
- Startday = Format(xDate, "YYYYMMDD")
- Startmonth = Format(xDate, "YYYYMM")
- '下載網站的網址
- With Sh.QueryTables.Add(Connection:="URL;http://www.twse.com.tw/ch/trading/exchange/MI_INDEX/genpage/Report" & Startmonth & "/A112" & Startday & "ALLBUT0999_1.php?select2=ALLBUT0999&chk_date=" & Format(xDate, "E/MM/DD"), Destination:=Range("A3"))
- .RefreshStyle = xlOverwriteCells '抓取網頁的第10個表格作為匯入資料
- .WebTables = "10"
- .Refresh BackgroundQuery:=False '當日(尚未有資料:錯誤)
- If Err.Number <> 0 Then GoTo EX
- If Application.CountA(Sh.QueryTables(1).ResultRange) = 0 Then '休市 沒有資料
- Msg = True
- GoTo EX
- End If
- End With
- With Sh.UsedRange
- .Font.Size = 12
- .EntireColumn.AutoFit
- End With
- MsgBox "交易的最新日期 " & xDate & vbLf & Application.Text(Time - T, "費時 [SS] 秒")
- End Sub
|
|
發表於 2013-9-2 11:21
| 