- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
7#
發表於 2016-10-8 08:15
| 只看該作者
回復 1# PKKO
試試看- Option Explicit
- Sub testDL() '下載股票資訊
- Dim IE As Object, st_date As String, xTable As Object, R As Integer, C As Integer
- st_date = "2016/02/01"
- Set IE = CreateObject("InternetExplorer.Application")
- IE.Visible = True
- IE.Navigate "http://www.cnyes.com/twstock/ps_historyprice/" & "3514" & ".htm"
- Do While IE.readyState <> 4: DoEvents: Loop
- With IE.Document
- R = .ALL.tags("table")(1).Rows.Length ' '**資料數(含表頭): 網頁預設顯示為一個月的資料
- '開始日期
- ' ************* 有ID 可直接用ID的名稱********
- .GetElementByid("ctl00_ContentPlaceHolder1_startText").Value = st_date
- Do While IE.readyState <> 4 Or IE.Busy: DoEvents: Loop
- 'For Each E In .GetElementsByTagName("INPUT")
- ' If E.ID = "ctl00_ContentPlaceHolder1_startText" Then
- ' E.Value = st_date: Exit For
- ' End If
- 'Next
- '查詢按鈕
- .GetElementByid("ctl00_ContentPlaceHolder1_submitBut").Click
- 'For Each E In .GetElementsByTagName("INPUT")
- ' If E.ID = "ctl00_ContentPlaceHolder1_submitBut" Then
- ' E.Click: Exit For
- ' End If
- 'Next
- '=================================下載資料=================================
- Do While IE.readyState <> 4 Or IE.Busy: DoEvents: Loop '這行程式碼無效，無法真的等待網頁執行時間
- Do
- DoEvents
- Set xTable = .ALL.tags("table")(1)
- If xTable.Rows.Length <> R And xTable.Rows.Length > 1 Then Exit Do ''** 等候資料日數等於指定的日數
- ' 等後資料下載時: xTable.Rows.Length=1
- Loop
- '=================================下載資料=================================
- With ActiveSheet
- .UsedRange = ""
- For R = 0 To xTable.Rows.Length - 1
- For C = 0 To xTable.Rows(R).Cells.Length - 1
- .Cells(R + 1, C + 1) = xTable.Rows(R).Cells(C).innertext
- Next
- Next
- End With
- MsgBox "資料下載完成!"
- End With
- IE.Quit
- End Sub
|
|
發表於 2016-10-7 15:27
| 
