更新股市每日盤後行情最新資料

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

1^# 跳轉到 »

發表於 2013-9-2 11:21 | 顯示全部帖子

本帖最後由 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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2013-9-3 07:19 | 顯示全部帖子

回復 6# gelai01000001
程式會無止盡的跑回圈?不會吧!是資料量大下載費時吧 !!
5#的程式碼已修正試試看

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

靜思自在 : 我們最大的敵人不是別人．可能是自己。