麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 請教如何在EXCELL取得該網站之"即時估計淨值" [打印本頁]

作者: yan2463 時間: 2015-7-9 10:44 標題: 請問網頁匯入問題

請問網頁匯入問題
我想將以下網頁匯入EXECL
http://www.yuantaetfs.com/#/RtNav/Index
但無法匯入,不知如何解決
這個網頁沒改版前是OK的

作者: lukychien 時間: 2015-7-11 01:09

回復 1# yan2463

要匯入風險預告及免責條款?

作者: jackyq 時間: 2015-7-12 09:09

excel 是無法吃 JAVASCRIPT 控制的網頁

作者: yan2463 時間: 2015-7-13 14:37

回復 2# lukychien

不是,是要匯入按同意後的即時預估淨值

作者: yan2463 時間: 2015-7-13 14:38

回復 3# jackyq

謝謝你

作者: GBKEE 時間: 2015-7-15 09:28

回復 5# yan2463
試試看用VBA巨集

Option Explicit
Sub Ex()
Dim E As Object
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://www.yuantaetfs.com/#/RtNav/Index"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Application.SendKeys "~", True '按下同意鍵
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Set E = .Document.getelementsbytagname("TABLE")(21)
.Document.body.innerHTML = E.outerHTML
.execwb 17, 2 ' Select All
.execwb 12, 2 ' Copy selection
With ActiveSheet
.Cells.Clear
.[A1].Select
.PasteSpecial 'Format:="HTML"
End With
.Quit '關閉網頁
End With
End Sub

複製代碼

作者: yan2463 時間: 2015-7-17 14:00

回復 6# GBKEE

謝謝

作者: lcctno 時間: 2015-7-19 00:38 標題: 請教如何在EXCELL取得該網站之"即時估計淨值"

請教如何在EXCELL取得該網站之"即時估計淨值" http://www.p-shares.com/#/RtNav/Index
我只能抓到一些無用的文字(內容如下)
【元大投信獨立經營管理】本基金經金管會核准或同意生效，惟不表示絕無風險。本公司以往之經理績效，不保證本基金之最低投資收益；本公司除盡善良管理人之注意義務外，不負責本基金之盈虧，亦不保證最低之收益，投資人申購前應詳閱基金公開說明書。本文提及之經濟走勢預測不必然代表基金之績效，基金投資風險請詳閱基金公開說明書。有關基金應負擔之相關費用，已揭露於基金公開說明書中，投資人可向本公司及基金之銷售機構索取，或至公開資訊觀測站及本公司網站中查詢。基金非存款或保險，故無受存款保險、保險安定基金或其他相關保障機制之保障。

麻煩高手指導我如何於EXCELL內將此網頁載入(如圖) 在此先謝謝您了
[attach]21412[/attach]

作者: lcctno 時間: 2015-7-19 08:53

回復 6# GBKEE

請問我依照您的內容做成VBA之按鈕但點按鈕只會自動開啟IE到那網站並不會自動把DATA匯入我的EXCELL內??
我是要能自動匯入DATA到EXCELL內我的無知(初學者) 還請您幫忙解惑謝謝您了

作者: lcctno 時間: 2015-7-19 09:12

回復 1# yan2463

請問您的問題解決了嗎?
能否幫初學者的我做個簡單的按鈕之EXCELL程式當點按鈕就能自動更新EXCELL內之"即時估計淨值"
先謝謝您了
由於我的級數很低無法在此下載若您或有看到這回覆訊息之高手若願意幫我麻煩私訊我我將告訴您我的mail

作者: GBKEE 時間: 2015-7-19 10:13

本帖最後由 GBKEE 於 2015-7-19 10:39 編輯

回復 6# lcctno
http://forum.twbts.com/thread-14577-1-1.html 會是同樣的問題嗎

作者: no3-taco 時間: 2015-7-19 11:26

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

參考看看
從版大程式碼再稍微修改的地方

Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
'Application.SendKeys "~", True '按下同意鍵 =>省略也可以
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Wait Now + #12:00:01 AM# =>好像缺一個等待時間
.
.
.
.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
.
.

複製代碼

作者: lcctno 時間: 2015-7-19 14:31

回復 11# GBKEE
我的問題是要做個簡單的按鈕之EXCELL程式當點按鈕就能自動更新EXCELL內之"即時估計淨值" 應該是不同的情形吧! 但還是非常的感謝您的回覆

作者: lcctno 時間: 2015-7-19 14:42

回復 12# no3-taco

非常的感謝您的回覆但對初次使用VBA的我很難由您所提供的修改而有能力的完全組合版大與您的建議去完成完整的VBA 可否拜託您給個完整的語法先謝謝您了

作者: GBKEE 時間: 2015-7-19 14:51

回復 13# lcctno

我的問題是要做個簡單的按鈕之EXCELL程式當點按鈕就能自動更新EXCELL內之"即時估計淨值" 應該是不同的情形吧!

可自行在工作表上插入一按鈕將"即時估計淨值"的程序指定到這按鈕

如圖
[attach]21414[/attach]

作者: lcctno 時間: 2015-7-19 14:59

回復 11# GBKEE

我很急著要用那功能原先"即時估計淨值" 一直都沒發生問題但元大寶來之網站改版之後我的原先土法鍊鋼之EXCELL檔就無法即時的知道淨值還需要另開網頁並手動輸入數個數據實在很頭大我已經發費很多時間爬文了但一直找尋不到方法所以最後不得不註冊加入會員並發帖求救希望能有人幫我.....

作者: lcctno 時間: 2015-7-19 15:58

回復 15# GBKEE

由於網站的規定我每小時只能回覆3次且又無權限發短消息很抱歉讓您久等我的回覆了

於第一時間時我有依您的語法完成但點它只會自動開啟IE並到那網站並不會自動把DATA匯入我的EXCELL內所以我才會繼續問下去希望有人能幫助笨笨的我解決這個問題其實我發現陸續有網站已無法使用 "匯入外部資料新增WEB查詢" 來取得DATA 所以我早晚還是要面對它並學會它

以下是我在apk.tw所發的帖若您對股市有興趣不妨去看看

碎鑽當然要想辦法賺但T50反1 (00632R)的真鈔您想賺嗎?
http://apk.tw/forum.php?mod=viewthread&tid=647659&fromuid=685805
(出處: Android 台灣中文網)

00632R T50反1 這帖沒碎鑽但有我賺真鈔的統計分析
http://apk.tw/forum.php?mod=viewthread&tid=672636&fromuid=685805
(出處: Android 台灣中文網)

作者: no3-taco 時間: 2015-7-19 16:09

你把版大的程式碼插入

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

試看看

作者: no3-taco 時間: 2015-7-19 16:18

回復 9# lcctno

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

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

作者: Farnsworth 時間: 2015-7-19 16:54

我試過了，能打開網頁，旦代碼 .document.body.innerHTML = E.outerHTML
這行提示出錯。

作者: lcctno 時間: 2015-7-19 17:09

回復 20# Farnsworth

我點按鈕ˇ並沒錯誤訊息 ˊ只是啟用了Internet Explorer幫我連到該頁面與我測試連結至YAHOO有完全不同的情形(結果) YAHOO 可抓到資料當然那是我測試抓的DATA(並非我要的DATA)
您可否貼上修正後完整的內容因為我沒能力自行組合但您寫的若真的可用那我可如法泡製非常的感謝您的熱情幫助在此謝謝您了還有希望不要被人當成灌水
ˊˊˊˊˊˊˊˊˊˊˊˊˊˊˊˊˊˊˊˊˊ

作者: no3-taco 時間: 2015-7-19 17:09

試看看

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

複製代碼

作者: lcctno 時間: 2015-7-19 17:26

本帖最後由 lcctno 於 2015-7-19 17:28 編輯

回復 22# no3-taco

結果一樣自動開 IE 到那網站

[attach]21415[/attach]

錯誤訊息1
[attach]21416[/attach]

錯誤訊息2 (偵錯結果)
[attach]21417[/attach]

作者: no3-taco 時間: 2015-7-19 17:50

我不太會用回復，再試看看

Option Explicit
Sub Ex()
Dim E As Object, myItems As Object, myitem
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://www.yuantaetfs.com/#/RtNav/Index"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
'Application.Wait Now + #12:00:01 AM# '有錯在開啟
Set myItems = .Document.getElementsByTagName("button")
For Each myitem In myItems
If myitem.Name = "Agree" Then
myitem.Click '按下送出查詢按鈕
End If
Next
Application.Wait Now + #12:00:01 AM#
Set E = .Document.getElementsByTagName("TABLE")(21)
.Document.body.innerHTML = E.outerHTML
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
With ActiveSheet
.Cells.Clear
.[A1].Select
.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
End With
.Quit '關閉網頁
End With
End Sub

複製代碼

作者: lcctno 時間: 2015-7-19 19:12

回復 25# no3-taco

哇真的成功了非常非常的感謝您的努力(幫助) 我得好好研究您提供的內容了

[attach]21418[/attach]

可用之測試檔
[attach]21419[/attach]

作者: no3-taco 時間: 2015-7-19 19:34

回復 26# lcctno

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

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

作者: GBKEE 時間: 2015-7-19 20:13

回復 27# no3-taco

Application.Wait Now + #12:00:02 AM# '經常沒抓到改2秒

網頁頻寬下載速度跟不上程式執行的速度所致
可修改如下

'Application.Wait Now + #12:00:01 AM#
Do
Set E = .Document.getElementsByTagName("TABLE")(21)
Loop Until Not E Is Nothing And E.ALL.Length = 431
.Document.body.innerHTML = E.outerHTML

複製代碼

如圖示程式會停在中斷點

[attach]21420[/attach]

作者: no3-taco 時間: 2015-7-19 20:22

回復 28# GBKEE

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

作者: yan2463 時間: 2015-7-23 10:06

回復 25# no3-taco

請問如果想每1分鐘,或每十分鐘自動更新一次,該如何改

作者: lcctno 時間: 2015-7-23 20:59

回復 1# yan2463

yan2463 請問您的問題解決了嗎?
yan2463 說：
回復 lcctno 我的問題尚未解決

回復 yan2463
請看 26樓
http://forum.twbts.com/redirect. ... 5&fromuid=21526

作者: yan2463 時間: 2015-7-24 09:28

回復 30# yan2463

我有下載25樓的VBA,想以這個檔案延伸
1.因需要按鈕才會更新,想請問是否有每一分或十分鐘檔案可自行更新
2.如要用按鈕更新,如何才能在在A工作表更新鈕,在工作表B更新
3.對VBA真的不熟,所以不知這樣問是否OK

作者: no3-taco 時間: 2015-7-24 14:10

回復 32# yan2463

這隻程式不適合定時執行，但還是貼上來給你參考!!

Option Explicit
Public doneT As Boolean
Sub Exnets123() '
Dim E As Object, tTime, tabtxt As String
With CreateObject("InternetExplorer.Application")
'.Visible = True 'False
.navigate "http://www.yuantaetfs.com/#/RtNav/Index"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
Application.SendKeys "~", True '按下同意鍵
'.document.getElementsByTagName("button")(0).Click '按下同意鍵
tTime = Timer
Do
Set E = .document.getElementsByTagName("TABLE")(21) '改(22)也可，E.all.Length="數量要跟著改"
DoEvents
If Timer - tTime > 5 Then MsgBox "請修改 E.all.Length =" & E.all.Length: Exit Do '確定無誤後可關閉
Loop Until Not E Is Nothing And E.all.Length = 415 '數量可能會不太一樣
tabtxt = .document.getElementsByTagName("TABLE")(21).outerHTML
tabtxt = Replace(tabtxt, "0"">▲", "")
tabtxt = Replace(tabtxt, "▼", "")
tabtxt = Replace(tabtxt, "0"">▲", "")
tabtxt = Replace(tabtxt, "▼", "")
.document.body.innerHTML = tabtxt
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
With ActiveSheet ''修改你要貼上的工作表
.Cells.Clear
.[a1].Select
.PasteSpecial 'NoHTMLFormatting:=True '(取消註解，改成純文字貼上)
End With
'Selection.Columns.AutoFit
.Quit '關閉網頁
End With
If doneT = True Then
Application.OnTime Time + #12:00:10 AM#, "Exnets123" '間隔多少時間開啟
End If
End Sub
Sub 開關() '另設按鈕
doneT = IIf(doneT = True, False, True) '自行修改適合的方式
MsgBox IIf(doneT = True, "定時開啟", "定時關閉") '開啟再去執行Exnets123程式就能間隔執行，關閉就能取消間隔執行
End Sub

複製代碼

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)