(不定期更新)使用VBA解決 excel web 查詢無法匯入、匯入太慢的股市資料

感謝樓主的詳細解釋和圖片說明,方便測試確認

snare wrote:
您是不是用了上市股票代號去測試,要上櫃的才行...(恕刪)

使用得股票代號都是使用Input 查尋到得去Key In。
剛剛又打開Excel測試,第一次按按紐可以下載,之後又不行了。然後使用debug一行一行執行後,和之前一樣也可以。然後再去按按紐試試,這次竟然怎麼key In,都可以執行了。

snare wrote:
還有如何把unicode轉成中文(利用html物件)(可回頭看看269樓,利用html轉url的方式)...(恕刪)

剛好也要複習#269,因為關鍵的轉碼Function還真的看不是很懂




有一些關於設立中斷點的問題,過去一直很困擾的問題請教一下。
因為若不清楚了解這部份,未來可能會誤解網頁執行時到底有無執行這一段程式碼。
(1)
即已知道滑鼠點擊 股票代碼input 查尋到的股票代碼會執行 Function query。
在 Element 的 Javascript 設 Break On Subtree modifications & attribute modifications & node removal,然後用滑鼠點擊查尋到的代碼,為什麼不會執行中斷在 Function Query,而是網頁原始碼竟然全執行完,連在任何一行中斷都沒有,是中斷的方法錯了嗎?



(2)
請問一下,在 Source 下,Row1260 or Row1261 orRow1262 設中斷點,為什麼都不會中斷停止,非得一定要設定在 Row1263 不可嗎?是中斷設定的位置又錯了?在 Function query 的程式碼一開始就設中斷點,錯了嗎?

另外問一下 "VM18 jquery.js",VM 是 Virtual Machine 的意思嗎?18是指執行18次了?
是否像物件一樣,可 set 物件 的執行體可 set 很多個,是一樣的概念?



(3)
在 Source 下,設定中斷點後,請問樓主有無遇到如下,這應該如何解釋
1. 一段一段執行,但怎麼都執行不完,永無止儘的感覺。(當然按最左邊的按紐還是會執行結束)
2. 一段一段執行,按個老半天終於程式碼執行完了,最後預期網頁應該會更新得部份竟然沒有跑出來。
3. 一段一段執行,按個老半天,網頁也已經更新如預期,但 Debug 還沒結束,按超久有時似乎好像沒有儘頭。或是執行完了,但不知道為什麼幾秒後又進入 Debug 模式,但明明例如只是設立 Mouse Click 的 Event,滑鼠也動都沒移動,又進入Debug 模式。

justinyutw wrote:
...(恕刪)

您的問題,離vba很遠、很遠了,找網址不用這麼麻煩啦
從發問的內容看,變成debug、反組譯網站、寫javascript…

不過還是回答一下好了




justinyutw wrote:
剛剛又打開Excel測試,第一次按按紐可以下載,之後又不行了。然後使用debug一行一行執行後,和之前一樣也可以。然後再去按按紐試試,這次竟然怎麼key In,都可以執行了。
...(恕刪)


應該是您的ip,暫時被tpex擋了一下
建議可改用別的網站練習

justinyutw wrote:
連在任何一行中斷都沒有,是中斷的方法錯了嗎?
...(恕刪)


justinyutw wrote:
是中斷設定的位置又錯了?在 Function query 的程式碼一開始就設中斷點,錯了嗎?
...(恕刪)


(點下可看大圖)





中斷沒錯,單步執行錯了,不是f8
是f9、f11、shift+f11
不要用vba除錯觀念,來使用chrome開發者工具的除錯
chrome有多種單步執行方式


詳細請參考
https://developers.google.com/web/tools/chrome-devtools/javascript/step-code?hl=zh-tw
(如果想進階一點,google網頁左邊的選單內文章,可以順便看一下)
https://www.ibm.com/developerworks/cn/web/1410_wangcy_chromejs/index.html

http://pymaster.logdown.com/post/168542-all-operate-under-the-context-of-the-chrome-extension-debug-methods
https://codertw.com/%E5%89%8D%E7%AB%AF%E9%96%8B%E7%99%BC/23990/


justinyutw wrote:
另外問一下 "VM18 jquery.js",VM 是 Virtual Machine 的意思嗎?18是指執行18次了?
...(恕刪)

vm=>是的
18=>不是,沒什麼意義,只是名字

請參考
http://siwei.me/blog/posts/chrome-console-vm-xxx-chrome-development-tool-console-s-vm-number
https://stackoverflow.com/questions/17367560/chrome-development-tool-vm-file-from-javascript

justinyutw wrote:
是否像物件一樣,可 set 物件 的執行體可 set 很多個,是一樣的概念?
...(恕刪)

這麼說也沒錯啦,不過要動到網頁裡的東西,需另外寫javascript

請參考
https://stackoverflow.com/questions/1705952/is-possible-to-debug-dynamic-loading-javascript-by-some-debugger-like-webkit-fi
https://github.com/bgrins/devtools-snippets
https://medium.com/@e_himmelfarb/interact-with-the-web-like-a-programmer-using-chrome-devtools-snippets-7648ff63a4c2
https://www.alexkras.com/using-code-snippets-in-chrome-developer-tools/
https://javascript.info/debugging-chrome
https://developers.google.com/web/tools/chrome-devtools/snippets

justinyutw wrote:
(3)
在 Source 下,設定中斷點後,請問樓主有無遇到如下,這應該如何解釋
1. 一段一段執行,但怎麼都執行不完,永無止儘的感覺。(當然按最左邊的按紐還是會執行結束)
2. 一段一段執行,按個老半天終於程式碼執行完了,最後預期網頁應該會更新得部份竟然沒有跑出來。
3. 一段一段執行,按個老半天,網頁也已經更新如預期,但 Debug 還沒結束,按超久有時似乎好像沒有儘頭。或是執行完了,但不知道為什麼幾秒後又進入 Debug 模式,但明明例如只是設立 Mouse Click 的 Event,滑鼠也動都沒移動,又進入Debug 模式。
...(恕刪)


1.js程式碼很多,又一大堆迴圈,單步執行很久,很正常
2.擋ip,或執行停太久,被網站清掉這次查詢了(我猜的)
3.也許是js裡面的mouse函數觸發的(我猜的)

2、3,不好意思用猜的,因為要確定原因,必需要把以下的.js程式碼都看一遍才行
好幾千行,實在提不起勁,不過tpex會擋ip,是很久以前就確定的事




今天剛好與 Snare 大相遇兩周年,
感謝 Snare 大這兩年來不辭辛苦在此講解。

祝您身體健康,笑口常開~~
樓主您好,不好意思,之前拜讀您的教學學到很多,最近有個程式原本可以使用,但可能因為網頁有改,現在無法下載了,嘗試了很久但還是無法解決,想請您幫忙看看,看有無解決的方法?感謝您!

我要下載的網址:http://smart.tdcc.com.tw/opendata/getOD.ashx?id=2-26

我的程式碼如下:

Sub 查每周餘額()

Dim myURL As String

'來源檔案
myURL = "http://smart.tdcc.com.tw/opendata/getOD.ashx?id=2-26"


Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.send

myURL = WinHttpReq.responseBody

If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody

'儲存檔案位置
oStream.SaveToFile (ThisWorkbook.Path & "\" & "CB-AS.csv")
oStream.Close

End If

End Sub


====================
原本程式可以正常使用的,但這星期不知道為什麼到了 If WinHttpReq.Status = 200 Then ,就直接跳到End If,在麻煩樓主了,感謝您!


hsh000081 wrote:
樓主您好,不好意思,之前拜讀您的教學學到很多,最近有個程式原本可以使用,但可能因為網頁有改,現在無法下載了,嘗試了很久但還是無法解決,想請您幫忙看看,看有無解決的方法?感謝您!

我要下載的網址:http://smart.tdcc.com.tw/opendata/getOD.ashx?id=2-26

我的程式碼如下:

...(恕刪)


網址變了
"https://smart.tdcc.com.tw/opendata/getOD.ashx?id=2-26"



這個可以取消
If WinHttpReq.Status = 200 Then
因為WinHttpReq.Open "GET", myURL, False =>用了false

感謝樓主的幫忙,我在試一下,感激不盡!
不曉得為何Yahoo要一直改台股股價的table位置?
還好是都可以很快自己改回來。

很感謝樓主無私地貢獻這麼多VBA相關的資訊與範例。
最近把樓主的範例與一些網路上找到的訊息,
拿來將之前用Web抓取失效(且速度又很lag)的美股歷史股價恢復了。
目前是抓csv檔再轉xlsx檔排序,因為要把最近的日期排最上面。
再把資料放進Excel的圖表中。

不過有個疑問:
若A.xlsm是執行VBA的主檔,抓下來的csv轉成X.xlsx。
並用手動將X.xlsx的資料抓進A.xlsm中的圖表中。
假如X沒開檔的話,在A的圖表中顯示的日期是一個字串;
要將X同時打開後,圖表中的日期才會是yyyy-mm-dd格式。

請問這是Excel原本的限制嗎?
還是有什麼地方可以改善的?
謝謝!

X檔沒開的時候


X檔中的日期格式


同時開啟X檔後,日期格式就正確

蔬食抗暖化,減碳救地球!

nijawang wrote:
假如X沒開檔的話,在A的圖表中顯示的日期是一個字串;
要將X同時打開後,圖表中的日期才會是yyyy-mm-dd格式。...(恕刪)


沒檔案,沒程式碼,我不知道您出了什麼問題

我隨便畫一個圖,沒出現您說的問題(excel 2016 x64)

snare大,您好:
不好意思沒附上檔案。
因為原本是想說這種問題是不是EXCEL 2013先天的限制,所以就沒附了。
[點擊下載]

我的問題是這樣:
我在test_Mobile01.xlsm中建VBA下載VT、BNDW、VTI歷史股價的csv檔,然後另外轉成xlsx檔。再於test_Mobile01.xlsm中把前面轉換的VT.xlsx…等檔案的最新股價資料利用Paste Link方式貼進來。並且從VT.xlsx中把歷史股價貼進來test_Mobile01.xlsm的圖表中。

但如果VT.xlsx這個檔案不同時開啟的話,則test_Mobile01.xlsm圖表中的日期就只是字串;
要同時開啟VT.xlsx檔後,圖表中的日期才會改成yyyy-mm-dd的格式。

不知道這是不是EXCEL本身的限制?

Paste Link:

不開啟VT.xlsx檔案時,日期格式為字串:

有時候座標還是日期,但指到資料點上還是字串:

若同時開啟VT.xlsx檔後,則日期格式就正確:



另外,我在另外的電腦(Office 365)上做Paste Link時,會變成動態連結(DDE)的方式。

變成只要一開啟test_Mobile01.xlsm時,在VBA中就可看到相關的檔案應該都被同時打開了。

所以這又造成VBA將csv轉為xlsx的存檔失敗,因為xlsx檔都被開啟了…
不知道這問題也有解嗎?
謝謝!

==================================================
Sub GetYahooStock_US()
Dim Xmlhttp As Object, lastrow As Integer, FileName As String, Url As String, Crumbkey As String, stock As String, startday As String, endday As String, TryAgain As Integer, ErrorStock As String
Dim endday_UnixTime As Long, startday_UnixTime As Long

On Error Resume Next

Sheets("US.Stock").Columns(9).Clear
Sheets("US.Stock").Cells(1, 11) = ""

endday = Date
startday = DateAdd("yyyy", -1, endday)
lastrow = Sheets("US.Stock").Range("a1").CurrentRegion.Rows.Count

Set Xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
With Xmlhttp
.Open "GET", "https://finance.yahoo.com/quote/VTI/history?p=VTI", False
.send
Crumbkey = Left(Split(.responsetext, """CrumbStore"":{""crumb"":""")(1), 11)

ttt = Timer

For i = 2 To lastrow
FileName = ""
stock = Sheets("US.Stock").Cells(i, 1).Value
Url = "https://query1.finance.yahoo.com/v7/finance/download/" & stock & "?period1=" & DataToUnixTime(startday) & "&period2=" & DataToUnixTime(endday) & "&interval=1d&events=history&crumb="
.Open "POST", Url & Crumbkey, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send
FileName = Split(.getresponseheader("Content-Disposition"), "filename=")(1)

If FileName <> "" And InStr(.responsetext, "Encountered an error") = 0 Then
j = j + 1
With CreateObject("ADODB.Stream")
.Type = 1
.Open
.Write Xmlhttp.ResponseBody
.SaveToFile ThisWorkbook.Path & "\" & FileName, 2
.Close
End With
Else
Sheets("US.Stock").Cells(i, 8) = "error"
TryAgain = TryAgain + 1
ErrorStock = ErrorStock & Sheets("US.Stock").Cells(i, 1) & vbNewLine
End If

DoEvents

Sheets("US.Stock").Cells(1, 11) = Round((i / lastrow) * 100, 2) & "%"
Next i


End With

MsgBox "成功下載" & lastrow - TryAgain & "筆,完成度" & Round(((lastrow - TryAgain) / lastrow) * 100, 2) & "%" & _
vbNewLine & "使用時間" & Timer - ttt & "秒" & _
vbNewLine & "以下" & TryAgain & "筆需重新下載或股票代號輸入錯誤" & _
vbNewLine & ErrorStock, vbOKOnly, "Report"

Set Xmlhttp = Nothing

Call CSVtoXLSX

End Sub
Function DataToUnixTime(dstring) As Long

DataToUnixTime = (DateValue(dstring) - #1/1/1970 8:00:00 AM#) * 86400
End Function

Sub CSVtoXLSX()
Dim xSPath As String
Dim xCSVFile As String
Dim xWsheet As String
Application.DisplayAlerts = False
Application.StatusBar = True

xSPath = ThisWorkbook.Path & "\"
xCSVFile = Dir(xSPath & "*.csv")
Do While xCSVFile <> ""
Application.StatusBar = "Converting: " & xCSVFile
Workbooks.Open FileName:=xSPath & xCSVFile
ActiveWorkbook.SaveAs Replace(xSPath & xCSVFile, ".csv", ".xlsx", vbTextCompare), xlOpenXMLWorkbook
With ActiveSheet
.Cells.EntireColumn.AutoFit
.Cells(1, 1).End(xlToRight).End(xlDown).Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlYes
Columns("A:A").EntireColumn.Select
Selection.NumberFormatLocal = "yyyy-mm-dd"

Columns("B:F").EntireColumn.Select
Selection.NumberFormatLocal = "0.00"

End With

ActiveWorkbook.Save

ActiveWorkbook.Close

xCSVFile = Dir

Loop
Application.StatusBar = False
Application.DisplayAlerts = True
End Sub
蔬食抗暖化,減碳救地球!
nijawang wrote:
不好意思沒附上檔案。
因為原本是想說這種問題是不是EXCEL 2013先天的限制,所以就沒附了。
...(恕刪)


從您附的檔案,發現您的圖表資料來源是其它檔案(跨檔案的連結)
日期會變來變去是正常的,是先天限制沒錯


如果您堅持一定要用“多檔案”
需用vba或用函數處理,先把日期改成文字
測試、處理方式,請參考476樓
或是參考麻辣這篇文章
http://forum.twbts.com/viewthread.php?tid=6382&extra=pageD1&page=1



nijawang wrote:
另外,我在另外的電腦(Office 365)上做Paste Link時,會變成動態連結(DDE)的方式。
變成只要一開啟test_Mobile01.xlsm時,在VBA中就可看到相關的檔案應該都被同時打開了。
所以這又造成VBA將csv轉為xlsx的存檔失敗,因為xlsx檔都被開啟了…
不知道這問題也有解嗎?
...(恕刪)


這種資料一直更新的圖表,建議用“單一檔案”的方式
下載後直接放在新的工作表就好,不要另建新檔,圖表資料來源指定為工作表
這樣就可隨時更新圖表,只有關閉檔案才會存檔一次,也可以同時解決日期的問題
(如圖,vt、vti、bndw下載後不存檔,直接放入工作表)


可參考271樓 Getyahoofinance_memory() 副程式,修改


另外,範例中為了輸入方便,日期都是改用8個數字的文字代替,所以定義成string

您參考271樓、272樓,自行改寫過的程式碼是錯的,無法下載資料,從這行開始就有問題了
startday = DateAdd("yyyy", -1, endday)


改寫271樓、272樓範例時,請把On Error Resume Next這行,暫時禁用
使用f8逐行執行,多多利用debug.print、區域變數視窗,來偵錯
請自行練習
關閉廣告
文章分享
評分
評分
複製連結
請輸入您要前往的頁數(1 ~ 144)

今日熱門文章 網友點擊推薦!