- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
8#
發表於 2018-1-30 12:46
| 只看該作者
本帖最後由 GBKEE 於 2018-1-30 12:47 編輯
回復 6# iamaraymond
這網頁用QueryTable 得取的資料有時起始日期會不準確,試試修改起始日期,看看資料是否正確
回復 7# Scott090 - Option Explicit
- Sub Ex_Ie_Copy()
- Dim Code As String, Price()
- Dim date0 As Date, StartDate$, EndDate$, timer, time0 As Date, IE_StartDate As String
- Dim E As Object, IE As Object
- Code = "2330"
- time0 = Time
- Application.StatusBar = "開啟網頁...."
- '設定資料開始及結束日期
- StartDate = Format(DateAdd("m", -12 * 10, Date), "yyyy/mm/dd") '取10年資料筆
- If StartDate < CDate("1994/09/07") Then
- MsgBox "StartDate " & StartDate & vbLf & "不可小於" & "1994/09/07"
- End
- End If
- EndDate = Format(Date, "yyyy/mm/dd")
- Set IE = CreateObject("InternetExplorer.Application")
- With IE
- .navigate "http://www.cnyes.com/twstock/ps_historyprice/" & Code & ".htm"
- Do: DoEvents: Loop While .Busy Or .readystate <> 4
- With .Document.getElementsByTagName("input")
- .Item("ctl00$ContentPlaceHolder1$startText").Value = StartDate ' 開始日期 input name
- .Item("ctl00$ContentPlaceHolder1$endText").Value = EndDate ' 結束日期 input name
- .Item("ctl00$ContentPlaceHolder1$submitBut").Click
- End With
- Do: DoEvents: Loop While .Busy Or .readystate <> 4
- On Error Resume Next
- Do
- Err.Clear
- Set E = .Document.getElementsByTagName("TABLE")(0)
- If E.INNERTEXT <> "" Then
- If Err = 0 Then
- If Abs(DateValue(E.Rows(E.Rows.Length - 1).Cells(0).INNERTEXT) - DateValue(StartDate)) <= 15 Then
- If Err = 0 Then Exit Do
- End If
- End If
- End If
- DoEvents
- Application.StatusBar = " 等候 網頁資料中 ... "
- Loop
- On Error GoTo 0
- CopyToClipbox E.OUTERHTML
- Application.StatusBar = StartDate & " - " & EndDate & " 資料共 " & E.Rows.Length - 1 & " 讀取.." & Application.Text(Time - time0, ["m分:S秒 ok"])
- .Quit
- End With
- End Sub
- Private Sub CopyToClipbox(strText As String) '文本拷貝到剪貼板
- With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
- .SetText strText
- .PutInClipboard
- End With
- With ActiveSheet
- .UsedRange.Clear
- .[A1].Select
- .Paste
- End With
- End Sub
- Sub Ex_Ie()
- Dim Code As String, Price()
- Dim StartDate$, EndDate$, time0 As Date
- Dim E As Object
- Dim Re%, Ce%
- Code = "2330"
- time0 = Time
- ActiveSheet.Cells.Clear
- Cells(1).Activate
- Application.StatusBar = "開啟網頁...."
- '設定資料開始及結束日期
- StartDate = Format(DateAdd("m", -12 * 10, Date), "yyyy/mm/dd") '取10年資料筆
- If StartDate < CDate("1994/09/07") Then
- MsgBox "StartDate " & StartDate & vbLf & "不可小於" & "1994/09/07"
- End
- End If
- EndDate = Format(Date, "yyyy/mm/dd")
-
- With CreateObject("InternetExplorer.Application")
- .navigate "http://www.cnyes.com/twstock/ps_historyprice/" & Code & ".htm"
- Do: DoEvents: Loop While .Busy Or .readystate <> 4
- With .Document.getElementsByTagName("input")
- .Item("ctl00$ContentPlaceHolder1$startText").Value = StartDate ' 開始日期 input name
- .Item("ctl00$ContentPlaceHolder1$endText").Value = EndDate ' 結束日期 input name
- .Item("ctl00$ContentPlaceHolder1$submitBut").Click
- End With
- Do: DoEvents: Loop While .Busy Or .readystate <> 4
- On Error Resume Next
- Do
- Err.Clear
- Set E = .Document.getElementsByTagName("TABLE")(0)
- If E.INNERTEXT <> "" Then
- If Err = 0 Then
- If Abs(DateValue(E.Rows(E.Rows.Length - 1).Cells(0).INNERTEXT) - DateValue(StartDate)) <= 15 Then
- If Err = 0 Then Exit Do
- End If
- End If
- End If
- DoEvents
- Application.StatusBar = " 等候 網頁資料中 ... "
- Loop
- On Error GoTo 0
- 'ReDim Price(0 To E.Rows.Length - 1, 0 To E.Rows(0).Cells.Length - 1)
- Application.StatusBar = StartDate & " - " & EndDate & " 資料共 " & E.Rows.Length - 2 & " 讀取...... "
- For Re = 0 To E.Rows.Length - 1 ' 19 '取19天的歷史紀錄
- For Ce = 0 To E.Rows(Re).Cells.Length - 1
- Cells(Re + 1, Ce + 1) = E.Rows(Re).Cells(Ce).INNERTEXT '日期、開、高、低、收、漲跌 漲% 成交量 成交金額
- ' Price(Re, Ce) = E.Rows(Re).Cells(Ce).innertext '日期、開、高、低、收、漲跌 漲% 成交量 成交金額
- Next
- Next
- 'ActiveSheet.Cells(1, "A").Resize(UBound(Price), UBound(Price, 2)).Value = Price
- Application.StatusBar = StartDate & " - " & EndDate & " 資料共 " & E.Rows.Length - 2 & " 讀取.." & Application.Text(Time - time0, ["m分:S秒 ok"])
- .Quit
- End With
- End Sub
|
|
發表於 2017-10-13 15:46
| 
