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

樓主您好,
請問以下的程式碼,為何執行紅色程式碼後產生錯誤,但若換成藍色程式碼卻可正常執行,不知要如何修正紅色部分的程式語法?

程式碼:
Sub tttt()

Cells.Clear

stockLine = 2

For i = 1 To 5

Range(Cells(stockLine, 1), Cells(sotckLine, 7)) = Array("獲利年度(季度/上下半年)", "現金股利發放日", _
"現金股利", "盈餘配股", "公積配股", "股票股利", "合計")

'Range("A" & stockLine & ":G" & stockLine & "") = Array("獲利年度(季度/上下半年)", "現金股利發放日", _
"現金股利", "盈餘配股", "公積配股", "股票股利", "合計")

stockLine = stockLine + 12
Next i

End Sub

錯誤訊息:
activer wrote:
執行紅色程式碼後產生錯誤



snare wrote:
請參考,200樓、1038...(恕刪)


謝謝snare大神的回覆
感覺不是程式碼的關係
因我200樓的方法就是我原本用的方法
現在發現程式可以成功建立目錄
但URLDownloadToFile 0, Url, Target & "t86.csv", 0, 0
檔案沒有下載下來 所以跑到TwseT86.OpenTextFile(Target & "t86.csv", 1)
會說找不到檔案

另外試了大大的新方法會出現以下錯誤

所以猜有可能是電腦的關係?
之前跑好好的也試過重裝不同版本 也是一樣
不過新方法找網路上找了好多解決方法 終於找到一個可以解決的方法
就是將MSXML2.XMLHTTP改成MSXML2.ServerXMLHTTP就解決了

不過下載股價getkgi的sub內容CreateObject("Microsoft.XMLHTTP)
也有出現一樣的錯誤 目前還找不到解決方法

另外303樓的gettaifex也同樣出現抓不到資料的現象
我一樣試著將MSXML2.XMLHTTP改成MSXML2.ServerXMLHTTP
確認.responsetext是有抓到資料的

但跑到最後 卻變成


不知大大是否知道該如何解決
另外對上面200樓的問題是否有什麼想法?


謝謝
snare wrote:
(恕刪)

rainbowsperm wrote:
但URLDownloadToFile 0, Url, Target & "t86.csv", 0, 0
檔案沒有下載下來


1038樓範例,只改了網址、檔名
其餘程式碼一字未改的情怳下,測試正常(只測試下載)


rainbowsperm wrote:
不過新方法找網路上找了好多解決方法 終於找到一個可以解決的方法
就是將MSXML2.XMLHTTP改成MSXML2.ServerXMLHTTP就解決了


1110樓範例,不是新方法,什麼特殊技巧都沒用到,只是很單純的xmlhttp下載

程式碼一字未改的情怳下,測試正常



rainbowsperm wrote:
另外303樓的gettaifex也同樣出現抓不到資料的現象
我一樣試著將MSXML2.XMLHTTP改成MSXML2.ServerXMLHTTP


在win10測試時,除了把 http://www.twse.com… => https://www.twse.com
gettaifex()副程式,程式碼一字未改的情怳下,測試正常


rainbowsperm wrote:
不過下載股價getkgi的sub內容CreateObject("Microsoft.XMLHTTP)
也有出現一樣的錯誤 目前還找不到解決方法


kgi 其中一台電腦測試失敗,(筆電win10 x64 21h1 + excel 2019(x64 ) + 送的norton 防毒)
另外4台正常
失敗那次,下載檔案正常,不存檔直接打開失敗
檢查後發現,移除norton防火牆後正常(可能不小心被設定到什麼)

程式碼一樣一字未改



rainbowsperm wrote:
感覺不是程式碼的關係
因我200樓的方法就是我原本用的方法


以上,使用5台電腦(3台桌上、2台筆電)
win7 x64 + excel 2007 + avira 防毒(免費版)
win7 x64 + excel 2016 (x32 x64) + avast 防毒(免費版)
win10 x64 21h1 + office 2007 + 內建防毒
筆電 win10 x64 20h2 + excel 2016(x64 ) + 內建防毒
筆電 win10 x64 21h1 + excel 2019(x64 ) + 送的norton 防毒

就和您說的一樣,其它不明原因??
您的問題很特別,我也不知道為什麼…
snare wrote:
1038樓範例,只改(恕刪)


大大電腦真多台 不好意思麻煩大大了~~
看來只好重裝系統再來試試看了
謝謝大神的幫忙

>>

謝謝snare大神
重新安裝WINDOWS系統 一切又回復正常了

有個新問題想請教
像https://www.macromicro.me/charts/20069/tw-mtx-long-to-short-ratio-of-individual-player
這種沒有form data的網站 有可能抓到他圖表上每日的值嗎?

謝謝
rainbowsperm wrote:
像https://www.macromicro.me/charts/20069/tw-mtx-long-to-short-ratio-of-individual-player
這種沒有form data的網站 有可能抓到他圖表上每日的值嗎?


寫法類似1064樓,要先拿到key才能取得資料
最近可參考的範例是1106樓
json取出、畫圖,這部份的程式碼,以您的能力,應該不是問題,請自行練習看看

*因網頁改版,此範例失效,請參考1329樓*

圖片來源:財經M平方 www.macromicro.me







Sub Get_Macromicro_Charts_JSON_Data()

Dim URL As String, URL_a As String, GetXml As Object, Jsondata As Object, DecodeJson, BlueLine, RedLine, datastk As String


Set GetXml = CreateObject("Msxml2.XMLHTTP")
Set Jsondata = CreateObject("HtmlFile")




URL = "https://www.macromicro.me/charts/data/20069"
URL_a = "https://www.macromicro.me/charts/20069/tw-mtx-long-to-short-ratio-of-individual-player"


With GetXml

.Open "GET", URL_a, False
.send

datastk = Split(Split(.responsetext, "data-stk=""")(1), """>")(0)

.Open "GET", URL, False
.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/92.0.4515.107 Safari/537.36"
.setRequestHeader "Authorization", "Bearer " & datastk
.setRequestHeader "Referer", URL_a
.send

Set DecodeJson = CallByName(CallByName(Jsondata.JsonParse(.responsetext), "data", VbGet), "c:20069", VbGet)

'台灣-小台指散戶多空比
Set BlueLine = CallByName(CallByName(DecodeJson, "s", VbGet), 0, VbGet)

'台灣 -加權股價指數
Set RedLine = CallByName(CallByName(DecodeJson, "s", VbGet), 1, VbGet)


'==================

'blueline、redline,json整理用程式碼放這裡









'==================


End With

Set GetXml = Nothing
Set Jsondata = Nothing
Set DecodeJson = Nothing
Set BlueLine = Nothing
Set RedLine = Nothing



End Sub

usbsilence
版主 請教您 此程序最近出現"此物件不支持此屬性"的錯誤信息, 請問是哪裡出了問題如何修改,謝謝
usbsilence
自問自答 s 改成 series 就可以了
snare wrote:
寫法類似1064樓,(恕刪)


謝謝大神
不過大神高估我的能力了哈 我都是靠大神的再稍作修改成自己需要的而已
剛好又遇到一個網站有需要 再來研究看看
再次謝謝大神
請教各位大大,小弟在抓取這個網址中的20年財報:
https://invest.cnyes.com/usstock/detail/DIS/financial/financials20yr

有發現它是另外用ajax再去查詢:
https://app.quotemedia.com/datatool/getFinancialsEnhancedBySymbol.json?symbol=DIS&numberOfReports=20&latestfiscaldate=true¤cy=true&reportType=A&token=30bba7083d1652b78234301d2cda78a7bd794dad5f3cb9492605a28a2e64cc2b
才返回json,問題是在request url帶了token。我找遍了F12裡network所有的XHR,也沒看出那裡生出的token (似乎是隨機的,每次開browser都不同)。

於是想說乾脆用Set oIE = CreateObject("InternetExplorer.Application") 的笨方法去操作IE,但是.....它好慢...它好慢...它好慢....幾乎快3分鐘才能抓下一檔財報.....

後來改成:
Set GetXml = CreateObject("msxml2.xmlhttp")
URL = "https://app.quotemedia.com/datatool/getFinancialsEnhancedBySymbol.json?symbol=DIS&numberOfReports=20&latestfiscaldate=true¤cy=true&reportType=A&token=30bba7083d1652b78234301d2cda78a7bd794dad5f3cb9492605a28a2e64cc2b"

With GetXml
.Open "GET", URL, False
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.setRequestHeader ":authority", "app.quotemedia.com"
.setRequestHeader "origin", "https://invest.cnyes.com"
.setRequestHeader "referer", "https://invest.cnyes.com/"
.setRequestHeader "sec-fetch-mode", "cors"
.setRequestHeader "sec-fetch-site", "cross-site"
.send
HTMLsourcecode.Body[removed] = .responsetext
End With

只要是token對,就能順利抓回json。
於是想說只要先開一個IE物件,去裡頭找第一次的request url裡頭帶的token拿出來用,但是就卡住了,因為不知道怎麼用InternetExplorer.Application的方法去取出中間呼叫的ajax所帶的參數...或是在那裡產生出的token..

各位大大能提供思路嗎? 感謝~~
snare wrote:
寫法類似1064樓,(恕刪)


最近疫情期間很久沒更新股票了,一更新不work了,這...一定Yahoo又改版了...
果不其然,一定要來這update一下.

版主的功課1117樓,順便做了一下,分享給同好們.

參考版主的1106說明取json內容放入excel中,完成的部份如附件.
只是圖表的部份,用了笨方法[錄製巨集方式]處理,圖表這個要用VBA來寫好像沒那麼容易.(看了1105樓的想改成雙軸折線圖,不知如何下手) 如果版主有空可以教教啊!

程式已更新至1125樓!
關閉廣告
文章分享
評分
評分
複製連結
請輸入您要前往的頁數(1 ~ 143)

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