返回列表 上一主題 發帖

[發問] 請教 如何在EXCELL取得該網站之"即時估計淨值"

本帖最後由 no3-taco 於 2015-7-19 11:28 編輯

參考看看
從版大程式碼再稍微修改的地方
  1. Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  2. 'Application.SendKeys "~", True   '按下同意鍵  =>省略也可以
  3. Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  4. Wait Now + #12:00:01 AM#     =>好像缺一個等待時間
  5. .
  6. .
  7. .
  8. .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
  9. .
  10. .
複製代碼

TOP

你把版大的程式碼插入

Wait Now + #12:00:01 AM#     =>好像缺一個等待時間

試看看

TOP

回復 9# lcctno

你不是說你做了按鈕,網頁也有開啟,所以應該是程式碼沒有抓到,給他延遲一秒看看

Wait Now + #12:00:01 AM#     '=>好像缺一個等待時間

TOP

試看看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim E As Object
  4.     With CreateObject("InternetExplorer.Application")
  5.         .Visible = True
  6.         .Navigate "http://www.yuantaetfs.com/#/RtNav/Index"
  7.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  8.         Application.SendKeys "~", True   '按下同意鍵
  9.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  10.         Application.Wait Now + #12:00:02 AM#   '修改的地方#######
  11.         Set E = .Document.getElementsByTagName("TABLE")(21)
  12.          .Document.body.innerHTML = E.outerHTML
  13.         .ExecWB 17, 2       '  Select All
  14.         .ExecWB 12, 2       '  Copy selection
  15.         With ActiveSheet
  16.             .Cells.Clear
  17.             .[A1].Select
  18.             .PasteSpecial 'Format:="HTML"
  19.         End With
  20.         .Quit        '關閉網頁
  21.     End With
複製代碼

TOP

我不太會用回復,再試看看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim E As Object, myItems As Object, myitem
  4.     With CreateObject("InternetExplorer.Application")
  5.         .Visible = True
  6.         .Navigate "http://www.yuantaetfs.com/#/RtNav/Index"
  7.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  8.         'Application.Wait Now + #12:00:01 AM#   '有錯在開啟
  9.         Set myItems = .Document.getElementsByTagName("button")
  10.         For Each myitem In myItems
  11.             If myitem.Name = "Agree" Then
  12.                 myitem.Click                              '按下送出查詢按鈕
  13.             End If
  14.         Next
  15.         Application.Wait Now + #12:00:01 AM#
  16.         Set E = .Document.getElementsByTagName("TABLE")(21)
  17.          .Document.body.innerHTML = E.outerHTML
  18.         .ExecWB 17, 2       '  Select All
  19.         .ExecWB 12, 2       '  Copy selection
  20.         With ActiveSheet
  21.             .Cells.Clear
  22.             .[A1].Select
  23.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
  24.         End With
  25.         .Quit        '關閉網頁
  26.     End With
  27. End Sub
複製代碼

TOP

回復 26# lcctno

.Visible = True 改成下面
.Visible = False    '可以隱藏ie

如果偶爾抓不到,多按幾下,或者把時間增加到兩秒
Application.Wait Now + #12:00:02 AM#   '經常沒抓到改2秒

TOP

回復 28# GBKEE

之前有一篇帖子也是卡在這裡,今天終於看到更好的解決辦法了。:lol

TOP

回復 32# yan2463

這隻程式不適合定時執行,但還是貼上來給你參考!!
  1. Option Explicit
  2. Public doneT As Boolean
  3. Sub Exnets123() '
  4.     Dim E As Object, tTime, tabtxt As String
  5.     With CreateObject("InternetExplorer.Application")
  6.         '.Visible = True 'False
  7.         .navigate "http://www.yuantaetfs.com/#/RtNav/Index"
  8.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  9.         Application.SendKeys "~", True   '按下同意鍵
  10.         '.document.getElementsByTagName("button")(0).Click  '按下同意鍵
  11.         tTime = Timer
  12.         Do
  13.             Set E = .document.getElementsByTagName("TABLE")(21)  '改(22)也可,E.all.Length="數量要跟著改"
  14.             DoEvents
  15.             If Timer - tTime > 5 Then MsgBox "請修改 E.all.Length =" & E.all.Length: Exit Do  '確定無誤後可關閉
  16.         Loop Until Not E Is Nothing And E.all.Length = 415  '數量可能會不太一樣
  17.         tabtxt = .document.getElementsByTagName("TABLE")(21).outerHTML
  18.         tabtxt = Replace(tabtxt, "<span class=""ng-hide"" ng-show=""o.navFluct>0"">▲</span>", "")
  19.         tabtxt = Replace(tabtxt, "<span class=""ng-hide"" ng-show=""o.navFluct<0"">▼</span>", "")
  20.         tabtxt = Replace(tabtxt, "<span class=""ng-hide"" ng-show=""o.priceFluct>0"">▲</span>", "")
  21.         tabtxt = Replace(tabtxt, "<span class=""ng-hide"" ng-show=""o.priceFluct<0"">▼</span>", "")
  22.         .document.body.innerHTML = tabtxt
  23.         .ExecWB 17, 2       '  Select All
  24.         .ExecWB 12, 2       '  Copy selection
  25.         With ActiveSheet    ''修改你要貼上的工作表
  26.             .Cells.Clear
  27.             .[a1].Select
  28.             .PasteSpecial 'NoHTMLFormatting:=True  '(取消註解,改成純文字貼上)
  29.         End With
  30.         'Selection.Columns.AutoFit
  31.         .Quit        '關閉網頁
  32.     End With
  33.     If doneT = True Then
  34.         Application.OnTime Time + #12:00:10 AM#, "Exnets123" '間隔多少時間開啟
  35.     End If
  36. End Sub
  37. Sub 開關() '另設按鈕
  38. doneT = IIf(doneT = True, False, True)  '自行修改適合的方式
  39. MsgBox IIf(doneT = True, "定時開啟", "定時關閉") '開啟再去執行Exnets123程式就能間隔執行,關閉就能取消間隔執行
  40. End Sub
複製代碼

TOP

        靜思自在 : 【行善要及時】行善要及時,功德要持續。如燒開水一般,未燒開之前千萬不要停熄火候,否則重來就太費事了。
返回列表 上一主題