- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
12#
發表於 2011-5-16 21:15
| 只看該作者
回復 12# carzyindex
下載一支股票要將近10分鐘 , 我沒測試完,請你慢慢測試 .- Option Explicit
- Sub 明細下載()
- Dim 股票代號 As Range, 日期 As Variant, i As Integer, A, T As Date
- Dim Rng As Range
- Do While Not IsDate(日期)
- 日期 = InputBox("輸入查詢日期", "日期", Date)
- If 日期 = "" Then End
- Loop
- 日期 = Format(日期, "yyyymmdd")
- Set 股票代號 = Workbooks("TEST.XLSX").Sheets("sheet2").[A1]
- Do While 股票代號.Value <> ""
- T = Time
- With Workbooks("TEST.XLSX").Sheets.Add(After:=Sheets(Sheets.Count))
- .Name = 日期 & "-" & 股票代號 '設立 在工作表名稱
- Application.StatusBar = False
- On Error GoTo A_Wait
- i = 1
- Do
- Set Rng = .Cells(Rows.Count, 1).End(xlUp).Offset(1)
- DoEvents
- With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & 日期 & "&StartNumber=" & 股票代號 & "&FocusIndex=" & i, Destination:=Rng)
- .Name = 日期 & "_" & 股票代號 & "_" & i
- .WebSelectionType = xlSpecifiedTables
- .WebFormatting = xlWebFormattingNone
- .WebTables = "6"
- .WebPreFormattedTextToColumns = True
- .WebConsecutiveDelimitersAsOne = True
- .WebSingleBlockTextImport = False
- .WebDisableDateRecognition = False
- .WebDisableRedirections = False
- ''''''無法查詢時稍待 到 A_Wait: '''''
- .Refresh BackgroundQuery:=False
- If Application.CountA(.ResultRange) = 0 Then GoTo Out
- i = i + 1
- End With
- A = CreateObject("WScript.Shell").popup("請等後下載..." & Chr(10) & Chr(10) & "** 請勿按下 [確定] **", 4, 日期 & "_" & 股票代號 & " 第" & i & "頁", 16 * 3 + 0)
- Application.ScreenUpdating = True
- Loop
-
- Out:
- .UsedRange.Columns.AutoFit
- ''''''''刪除 A,F欄的空格 ''''''''''''''''''''''''''''''''
- .Range(.Cells(Rows.Count, "B").End(xlUp).Offset(1), .Cells(Rows.Count, "B")).Offset(, -1).Clear
- .Range(.Cells(Rows.Count, "G").End(xlUp).Offset(1), .Cells(Rows.Count, "G")).Offset(, -1).Clear
- '''''''''''''''''''''''''''''''''''''''
- A = CreateObject("WScript.Shell").popup("共下載" & i & "頁", 5, 日期 & "_" & 股票代號, 48 + 0)
- Application.StatusBar = 股票代號 & " 共下載 " & i & "頁 費時 " & Format(Time - T, "HH:MM:SS")
- End With
- Set 股票代號 = 股票代號.Offset(1)
- Loop
- End
- A_Wait:
- Application.StatusBar = "無法查詢等候10秒鐘" '網頁繁忙時程式會有錯誤
- Application.Wait Now + TimeValue("00:00:10") '可增加等候查詢的秒數
- Err.Clear
- Application.StatusBar = False
- Resume '重返查詢
- End Sub
|
|
發表於 2011-5-16 16:16
| 
