Web 資料匯入問題

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 255
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-24

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

3^# 跳轉到 »

發表於 2013-5-16 23:07 | 只看該作者

回復 2# seemee

Sub 個股交易明細下載()
Dim 股票代號 As String, 年 As String, 月 As String, N As Name, i As Integer, T As Integer, A
年 = 2013
月 = 1
月 = Format(月, "00")
股票代號 = 2330
T = Time
With ActiveSheet
.Cells.Clear
DoEvents
'Application.ScreenUpdating = False
'Application.StatusBar = False
With .QueryTables.Add(Connection:="URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & 年 & 月 & "/" & 年 & 月 & "_F3_1_8_" & 股票代號 & ".php?STK_NO=" & 股票代號 & "&myear=" & 年 & "&mmon=" & 月, Destination:=Range("A1"))
.BackgroundQuery = True
.WebTables = "8"
.Refresh BackgroundQuery:=False
ActiveSheet.Names(.Name).Delete
End With
月 = 2
Do
月 = Format(月, "00")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Select
With .QueryTables.Add(Connection:="URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & 年 & 月 & "/" & 年 & 月 & "_F3_1_8_" & 股票代號 & ".php?STK_NO=" & 股票代號 & "&myear=" & 年 & "&mmon=" & 月, Destination:=Selection)
.BackgroundQuery = True
.WebTables = "8"
On Error Resume Next
Do
Err.Clear
.Refresh BackgroundQuery:=False
If Err.Number = 1004 Then GoTo 10 '無法開啟檔案就跳到下一月
Loop Until Err.Number = 0
On Error GoTo 0
If Application.CountA(.ResultRange) = 0 Then GoTo OUT
.ResultRange.Rows("1:2").Delete '刪除1:2列
ActiveSheet.Names(.Name).Delete
10
月 = 月 + 1
End With
Loop Until 月 > 12
OUT:
.[A1].Select
Application.ScreenUpdating = True
With .UsedRange
.WrapText = False
.Interior.ColorIndex = xlNone
.Font.Size = 12
.Columns.AutoFit
A = CreateObject("WScript.Shell").popup("共下載 " & i & " 頁費時 " & Format(Time - T, "hh:mm分SS秒"), 5, 年 & "_" & 股票代號, 48 + 0)
Application.StatusBar = 年 & " _ " & 股票代號 & " 共下載 " & i & "頁費時 " & Format(Time - T, "HH:MM:SS")
End With
For Each N In .Names
N.Delete
Next
End With
End Sub