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

樓主您好,
終於將整個討論串(580樓)看完,基本上21樓範例程式已相當實用了,樓主雖陸續有些程式範例推出,但內容有些太進階,實在無法完全理解,只能依原樓層的範例操作測試;有些使用的觀念及問題想請教樓主:
1.在XMLHTTP中GET/POST方式,有關”.setRequestHeader "Referer", Url”的命令及”.send 參數”,似乎GET方式通常不需要,而POST較常使用,是否有較簡易方式,可以判斷應加入那個Url及參數

2.有關170樓的程式,執行時會有執行階段錯誤”5”,應如何排除


3.有關219樓的程式,執行時會有執行階段錯誤”438”,雖然在459樓網友也發生同樣問題,但其似乎在” 盤中10:08 更新 有z出現”後解決了,但小弟也試著在不同時段執行,仍無法排除該錯誤,還請樓主提供一些方向


4.https://index.ndc.gov.tw/n/zh_tw/data/eco
https://index.ndc.gov.tw/n/zh_tw/data/eco/indicators_table1
小弟試著以”使用開發者工具(f12)(f5)”,進入查看網頁的GET/POST及可能網址,感覺是POST方式,但找不到可以取資料的網址及方式,能否請樓主提點一下,謝謝


請教版大,下面這句 DateAdd("d", -1, Date)
在A電腦跑是可執行的,但在B電腦卻出現 "執行階段錯誤5程序呼叫或引數不正確"
是因為少安裝了甚麼嗎?
yuhuahsiao wrote:
下面這句 DateAdd("d", -1, Date)
在A電腦跑是可執行的,但在B電腦卻出現 "執行階段錯誤5程序呼叫或引數不正確" ...(恕刪)



請參考 555樓

或參考微軟說明
https://support.microsoft.com/zh-tw/help/290969/run-time-error-5-when-you-use-mid-left-or-right-function

或貼出程式碼、excel版本,方便測試
activer wrote:
但內容有些太進階,實在無法完全理解,只能依原樓層的範例操作測試
...(恕刪)


不好意思,因為不是教學,而是提供各種可使用"方法"
所以範例中可以看到很多不同的寫法,因此難度偏高


activer wrote:
1.在XMLHTTP中GET/POST方式,有關”.setRequestHeader "Referer", Url”的命令及”.send 參數”,似乎GET方式通常不需要,而POST較常使用,是否有較簡易方式,可以判斷應加入那個Url及參數
...(恕刪)


我不是在568樓回答過您了
至於參數,簡單一點的就是看fiddler(568樓的圖片)中的 webforms
裡面就是網址需要send的參數

activer wrote:
2.有關170樓的程式,執行時會有執行階段錯誤”5”,應如何排除
...(恕刪)


2017年寫的範例,我懶的改了
主要原因就是那個z (最近成交價),不一定有資料
所以在取物件的時候,沒資料就會出錯
可用if 先檢查,或是用on error resume next 跳過(請參考585樓)

activer wrote:
3.有關219樓的程式,執行時會有執行階段錯誤”438”,雖然在459樓網友也發生同樣問題,但其似乎在” 盤中10:08 更新 有z出現”後解決了,但小弟也試著在不同時段執行,仍無法排除該錯誤
...(恕刪)


一、可用if先檢查是不是開盤時間,再執行取z的資料
二、可用if先檢查z不是空白,再執行取z的資料
三、直接用 on error resume next 跳過沒資料時會出現的錯誤(請參考585樓)

activer wrote:
4.https://index.ndc.gov.tw/n/zh_tw/data/eco
小弟試著以”使用開發者工具(f12)(f5)”,進入查看網頁的GET/POST及可能網址,感覺是POST方式,但找不到可以取資料的網址及方式,能否請樓主提點一下,謝謝
...(恕刪)


post 沒錯
這個網址會讓很多人上當,以為每次更改日期區間都會送出查詢
提示就不給了
因為這個網址適合做範例,(請參考585樓)

國發會景氣指標查詢系統,下載範例
https://index.ndc.gov.tw/n/zh_tw/data/eco

這個網址會讓很多人上當,以為每次更改日期區間都會送出查詢
日期區間選來選去,使用開發者工具(或是fiddler第三方程式),就是找不到send所需要的參數



其實,在每次選擇中,跟本沒送出查詢
因為景氣指標(數字)這種東西,一個月才1個數字,資料量超級小
全部的資料,就在您開網頁的一瞬間,就下載到電腦裡面了(json格式)




根本不需要煩惱那些年份、月份的問題
那些表格、圖表…等等的變化,其實全部是離線資料,在您的電腦上處理、重畫


'===================================================
Sub get_ndc()

Dim xmlhttp As Object, Jsondata As Object, Url As String, Url_a As String, DecodeJson, temp
Set Jsondata = CreateObject("HtmlFile")
Set xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")

Jsondata.write ”<script>document.JsonParse=function (s) {return eval(’(’ + s + ’)’);}</script>”

'Jsondata.write 這行程式碼,符號是全形字,複製後,請改成半形,或直接看附加檔案

Url = "https://index.ndc.gov.tw/n/json/data/eco/indicators"
Url_a = "https://index.ndc.gov.tw/n/zh_tw/data/eco"

On Error Resume Next

Sheets("工作表1").Cells.Clear

With xmlhttp

.Open "POST", Url, False
.setRequestHeader "Referer", Url_a
.send

Set DecodeJson = Jsondata.JsonParse(.responsetext)

Set temp = CallByName(CallByName(CallByName(DecodeJson, "line", VbGet), "12", VbGet), "data", VbGet)
'2=景氣對策信號 (燈號分數)
'12=景氣對策信號 (程式預設下載代號)
'13=同時指標綜合指數
'14=同時指標不含趨勢指數
'25=落後指標綜合指數
'26=落後指標不含趨勢指數
'33=領先指標綜合指數
'34=領先指標綜合指數
'34打錯字了,應該是⇒不含趨勢指數
'請自行修改附加檔案

'2019/2/27 補充,不使用on error 可參考587樓
Dim i As Integer, x As String, y As String
i = 0
Do
x = "": y = ""
x = CallByName(temp, i, VbGet).x
y = CallByName(temp, i, VbGet).y
i = i + 1
Sheets("工作表1").Cells(i, 1) = x
Sheets("工作表1").Cells(i, 2) = y

If x = "" Then Exit Do
Loop

End With

Set Jsondata = Nothing
Set DecodeJson = Nothing
Set xmlhttp = Nothing


End Sub


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

下載a欄是日期4碼西元+2碼月份(1984_01之後才有資料),b欄是信號、指數、分數
其它信號、指數,請看註解自行修改程式碼

資料下載之後,只要有一定的excel圖表製作能力,就可以做出和網站上一模一樣的圖、表格…




json 資料物件,請試著使用f8逐行執行,在區域變數視窗,試著自行理解
或回頭看以前的說明,或google




附加壓縮檔: 201902/mobile01-2ab495709d2d2b11d74aa2d3be46b5ba.zip
snare wrote:
我不是在568樓回答過您了至於參數,簡單一點的就是看fiddler(568樓的圖片)中的 webforms...(恕刪)


樓主您可能誤解了,在568樓的回覆中,小弟已可透過”開發工具f12,f5的方式”,取得一些可能的網址及參數,所以未再使用fiddler這個工具,而且fiddler官網似乎要設定cookier後才能下載,在不清楚下,暫時未使用
而本次會再詢問樓主,是指如何判斷.setRequestHeader "Referer", Url”的命令中的Url是那個才是正確,因為看您的範例中,有的是以”.Open "POST", Url, False”中的Url再代入 “referrer”中的url,有的範例卻是兩個不同的url,若這是要依賴經驗,那就算了,若是有規則,還請樓主告知可能方法



snare wrote:
這個網址會讓很多人上當,以為每次更改日期區間都會送出查詢
提示就不給了...(恕刪)


其實樓主就算給提示,小弟可能還是無力執行,因為小弟曾以f12,f5曾進入網頁,看到json字集相關資料,因為看不懂,當然無法解析json取得資料,所幸樓主您直接作範例上傳,謝謝;
小弟回頭再看498樓有關json的說明,仍有些不懂,請教樓主有關Jsondata.write "...function (s) {return eval('(' + s + ')')",是將javascript命令寫到何處?而Jsondata.write是vba命令還是js命令?
另有關CallByName這個函數,曾google這個函數,但都是很制式的說明,實在連結不上本次範例的內容,樓主能否單純就CallByName(DecodeJson, "line", VbGet)這一個部分簡單說明拆解
activer wrote:

而本次會再詢問樓主,是指如何判斷.setRequestHeader "Referer", Url”的命令中的Url是那個才是正確,因為看您的範例中,有的是以”.Open "POST", Url, False”中的Url再代入 “referrer”中的url,有的範例卻是兩個不同的url,若這是要依賴經驗,那就算了,若是有規則,還請樓主告知可能方法
...(恕刪)


通常來說就是拿資料那個網頁的上一個網頁(一般都是首頁)

以這個網頁來說,產生資料的不是這一頁,這個首頁是整理資料、畫表格、畫圖用的
a、https://index.ndc.gov.tw/n/zh_tw/data/eco
資料來源是這個
b、https://index.ndc.gov.tw/n/json/data/eco/indicators

假設一棟房子,a是1樓,b是10樓

我要去10樓拿資料,有幾個方法
一、從一樓進去
二、空降… or 其它不經過一樓的方式

如果10樓有警衛,要檢查是不是從一樓進來(例如:一樓保全給的證件)
沒有就不讓您進10樓

萬一我是從9樓破窗進來,那不就沒有證件
那我是不是可以準備好一個假證件進去
.setRequestHeader "Referer",就類似偽造一個假來源的意思



但"Referer",不一要加上
不是所有的網站都會檢查來源,通常不加,也可以正常用xmlhttp下載
(我是習慣不管有沒有檢查,除了不小心忘記之外,基本上都會加)




activer wrote:
小弟回頭再看498樓有關json的說明,仍有些不懂,請教樓主有關Jsondata.write "...function (s) {return eval('(' + s + ')')",是將javascript命令寫到何處?而Jsondata.write是vba命令還是js命令?
...(恕刪)


javascript寫到何處=>一個在記憶體中的htmlfile物件
您就把它當作一個還沒存檔的html網頁,就好了

jsondata =>自定義名稱,可以隨便改
.write =>htmlfile 物件的方法,照字面翻譯,就是寫入,算是vba命令

"...function (s……" => jscript

會用這種方式寫是因為 x32 x64 通用,且“純vba”
網路上scriptcontrol物件的json範例(excel x32)一大堆,但缺點就是不能直接用在 x64
如果要在excel x64上用 scriptcontrol物件,需另外寫一堆程式碼配合才行


請參考 504樓、505樓、522樓

activer wrote:
單純就CallByName(DecodeJson, "line", VbGet)這一個部分簡單說明拆解
...(恕刪)


沒用jscript 解碼之前



用jscript 解碼之後,會產生一種名稱為jscriptTypeinfo的特別物件(物件+陣列)
而且每一層都會分類好,用jscript就是這麼好整理


由即時變數視窗(或是google開發者工具,或是第三方工具fiddler,都可以事先看到整理好的json)





可知要的資料在
line(jscriptTypeinfo)=>12(jscriptTypeinfo)=>data(jscriptTypeinfo)=> 0~????(jscriptTypeinfo)內
需要的是 x(日期),y(數字)=>標準變數

但vba 無法直接用標準物件方式存取jscriptTypeinfo物件
for each ... 也不行

而callbyname這個特殊函數,剛好可以跳過這個限制
以這個網頁的json資料來說,前3層是jscriptTypeinfo,所要用callbyname + vbget ,拆3次
最後一層x.y是標準變數,就可以用vba的通用語法來處理


585樓那個範例,只是為了簡單說明物件沒資料時,用on error 讓vba不會出錯中斷

不用on error 也可以改寫成下面這樣
Dim i As Integer, last_data As Integer
last_data = CallByName(temp, "length", VbGet)

For i = 0 To last_data - 1
Sheets("工作表1").Cells(i + 1, 1) = CallByName(temp, i, VbGet).x
Sheets("工作表1").Cells(i + 1, 2) = CallByName(temp, i, VbGet).y
Next i

callbyname還有很多特殊用法,可自行google callbyname 的範例
感謝版大的詳細說明

也謝謝activer 的問題
首先感謝樓主(師傅)讓我見識到了眼界

小弟是近日才看到這個文章~目前努力在看一系列的文章~不過只是努力追到200多樓而已@@

我想請教一個問題

下面的code 是樓主(師傅)提供的去微改要抓資料用~但就是無法順利將網頁內的資料抓進來~不知這網頁是有啥特別不同
會抓不到產生的表格內容~還望各位指教,謝謝

P.S. 這是小弟第一次發文,如有不敬,還請見諒@@

Sub getpost()

Cells.Clear
Dim HTMLsourcecode, Url, Url_a, TempArray(), Table, Title
Set HTMLsourcecode = CreateObject("htmlfile")


Url = "https://www.sitca.org.tw/ROC/Industry/IN2629.aspx?pid=IN22601_04"
Url_a = "" & _
"&ctl00$ContentPlaceHolder1$ddlQ_YM=201901" & _
"&ctl00$ContentPlaceHolder1$rdo1=rbComid" & _
"&ctl00$ContentPlaceHolder1$ddlQ_Comid=A0009" & _
"&ctl00$ContentPlaceHolder1$BtnQuery=查詢"



ttt = Timer
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", Url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", Url
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/72.0.3626.119 Safari/537.36"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.Send Url_a

HTMLsourcecode.body.innerhtml = .Responsetext
Debug.Print HTMLsourcecode.body.innerhtml


End With
Set HTMLsourcecode = Nothing
Set Table = Nothing
Erase TempArray()
End Sub





隨風而至 wrote:
下面的code 是樓主(師傅)提供的去微改要抓資料用~但就是無法順利將網頁內的資料抓進來~不知這網頁是有啥特別不同
會抓不到產生的表格內容~還望各位指教,謝謝

P.S. 這是小弟第一次發文,如有不敬,還請見諒@@

Sub getpost()

Cells.Clear
Dim HTMLsourcecode, Url, Url_a, TempArray(), Table, Title
Set HTMLsourcecode = CreateObject("htmlfile")


Url = "https://www.sitca.org.tw/ROC/Industry/IN2629.aspx?pid=IN22601_04"...(恕刪)



請改用456樓的寫法



提示一:
url_a = "__EVENTTARGET=&__EVENTARGUMENT=&__LASTFOCUS=" & _
"&__VIEWSTATE=" & UrlEncode(vs) & _
"&__VIEWSTATEGENERATOR=" & vg & _
"&__EVENTVALIDATION=" & UrlEncode(ev) & _
"&ctl00$ContentPlaceHolder1$ddlQ_YM=201901" & _
"&ctl00$ContentPlaceHolder1$rdo1=rbComid" & _
"&ctl00$ContentPlaceHolder1$ddlQ_Comid=A0009" & _
"&ctl00$ContentPlaceHolder1$BtnQuery=查詢"

提示二:
表格部份改用剪貼薄處理

請試著自己寫看看
關閉廣告
文章分享
評分
評分
複製連結
請輸入您要前往的頁數(1 ~ 143)

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