bioleon69 wrote:
decodejson這邊出現錯誤了...(恕刪)
提示1
Url = "https://www.nvesto.com/tpe/broker/8440/AjaxGetBroekBuySellListData"
提示2
"POST"
提示3
.send ????????????????
個人積分：2598分
文章編號：66913510
個人積分：63分
文章編號：66923402
個人積分：2598分
文章編號：66924672
bioleon69 wrote:
能指點IE的招式麻?...(恕刪)
ie 登入後才能用 set table 方式抓資料
雖然我知道怎麼寫，但ie效率實在太差，我不想討論
帳號登入問題可參考21樓或自行google
這個網頁，只是把資料遮起來而已，其實打開就下載好了
所以 xml 方式不需要登入網站就能抓資料，不是什麼特殊技巧
提示四：
.Open "POST", Url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", Urla
.send "point=all&fromdate=2017-12-27&opt=net"
dim DecodeJson, Databuy, Datasell
Set DecodeJson = Jsondata.JsonParse(.responsetext)
Set Databuy = CallByName(CallByName(DecodeJson, "data", VbGet), "buy", VbGet)
Set Datasell = CallByName(CallByName(DecodeJson, "data", VbGet), "sell", VbGet)
這有一半程式碼了，請試著自己寫看看
個人積分：63分
文章編號：66966170
Cells.ClearContents
Dim jsondata, Url, Url_a, decodejson
Set jsondata = CreateObject("htmlfile")
Url = "https://www.nvesto.com/tpe/broker/8440/AjaxGetBroekBuySellListData"
Url_a = "https://www.nvesto.com/tpe/broker/8440"
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", Url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", Url_a
.send "point=all&fromdate=2017-12-27&opt=net"
Set decodejson = jsondata.JsonParse(.responsetext)
End With
End Sub
decodejson就錯誤了
個人積分：2598分
文章編號：66971846
(https://www.nvesto.com/tpe/broker/8440/buysell#!/point/all/fromdate/2017-12-29/opt/net)
摩根大通買賣超下載範列
未登入時
登入後，但是不用登入也可以，因為資料只是用java遮起來而已
這個範例的相關說明，請從277樓開始看
'=====================================================================
'程式碼請放在模組裡
Sub nvesto_Jsondata()
Dim Xmlhttp As Object, Jsondata As Object, Url As String, Urla As String, DecodeJson, Databuy, Datasell, day As String, datalength As Integer, buy_length As Integer, sell_length As Integer, d, temp
On Error Resume Next
Set Jsondata = CreateObject("HtmlFile")
Jsondata.write ”＜script＞document.JsonParse＝function （s） ｛return eval（’（’ ＋ s ＋ ’）’）；｝＜／script＞”
'Jsondata.write 這行符號是全形字，複製後，請改成半形，或直接看附加檔案
If Weekday(Date) = 1 Then d = 2
If Weekday(Date) = 7 Or Time < TimeValue("16:00") Then d = 1
day = Format(InputBox("請輸入查詢日期(8碼數字)", , Format(Date - d, "yyyymmdd")), "####-##-##")
If day = "" Then Exit Sub
ttt = Timer
Url = "https://www.nvesto.com/tpe/broker/8440/AjaxGetBroekBuySellListData"
Urla = "https://www.nvesto.com/tpe/broker/8440/buysell"
Set Xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
With Xmlhttp
.Open "POST", Url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", Urla
.send "point=all&fromdate=" & day & "&opt=net"
If Len(.responsetext) < 100 Then
MsgBox "查無資料，或網路忙線", vbOKOnly, "report"
Exit Sub
End If
Set DecodeJson = Jsondata.JsonParse(.responsetext)
Set Databuy = CallByName(CallByName(DecodeJson, "data", VbGet), "buy", VbGet)
Set Datasell = CallByName(CallByName(DecodeJson, "data", VbGet), "sell", VbGet)
Application.ScreenUpdating = False
For I = 1 To 2
With Sheets(Choose(I, "賣超", "買超"))
.Select
.Cells.Clear
.Range("a1:h1") = Array(Choose(I, "賣超", "買超") & "股票", "", "買進", "賣出", Choose(I, "賣超", "買超"), "比重", "總金額", "均價")
.Columns("A:A").NumberFormatLocal = "@"
For j = 0 To CallByName(Choose(I, Datasell, Databuy), "length", VbGet) - 1
Set temp = CallByName(Choose(I, Datasell, Databuy), j, VbGet)
.Cells(j + 2, 1) = temp.stockID: .Cells(j + 2, 2) = temp.stockName
.Cells(j + 2, 3) = temp.buy
.Cells(j + 2, 4) = temp.sell
.Cells(j + 2, 5) = temp.net
.Cells(j + 2, 6) = temp.fraction
.Cells(j + 2, 7) = temp.net_price
.Cells(j + 2, 8) = temp.avg_price
Next j
.Cells.EntireColumn.AutoFit
If I = 1 Then sell_length = j Else buy_length = j
End With
Next I
Application.ScreenUpdating = True
End With
MsgBox "查詢日期" & day & vbNewLine & _
"買超資料筆數" & buy_length & "筆" & vbNewLine & _
"賣超資料筆數" & sell_length & "筆" & vbNewLine & _
"使用時間" & Round(Timer - ttt, 2) & "秒", vbOKOnly, "下載完成"
Set Xmlhttp = Nothing
Set DecodeJson = Nothing
Set Databuy = Nothing
Set Datasell = Nothing
Set temp = Nothing
End Sub
'=====================================================================
建議不要只是下載，json格式的解碼方式可參考170樓、219樓、274樓
搞不懂的話，請去麻辣論壇找ie object 範例，那邊ie object範例資源超多
不像我只在21樓稍微提到一點點而已
雖然用ie object方式，速度慢，但非常容易上手，不用考慮什麼java json 的格式問題
只要網頁打的開，就能下載。
附加壓縮檔: 201712/mobile01-58774b9f2b38f9c6b36acbcdbef57078.zip
個人積分：63分
文章編號：66992251
個人積分：1分
文章編號：67247844
個人積分：1分
文章編號：67282128
個人積分：2598分
文章編號：67284131
個人積分：1分
文章編號：67290855
不好意思，馬上改進
你提到其他樓的方式，我再試試看
只是有點好奇同一組 URL 為什麼 GET 方法在 .send 就 error 了
而 POST 不會
如果師傅有空的話請再幫忙解惑
149樓的方式去是抓各種列表，這個可以抓得起來沒問題
但如果抓基本分析的現金流量
用 F12 看一下是用 Get 方法
用 Get 來抓的時候就遇到上面問題。
269樓的方式
要先取得2個參數 VIEWSTATE+EVENTVALIDATION
再啟動網頁上的java程式(假按鈕)
所以也可以運用在這邊下載 .XLS 檔案了?
還在理解 VIEWSTATE 跟 EVENTVALIDATION
請問什麼情況下才知道適用此方法然後要去找這兩個值呢
是不是沒網址+不會顯示在網頁表格裡+不會出現在網頁原始碼裡面，
就可能要用這樣的方法來抓?
還不太能判斷該使用的正確方法
以下附上程式碼
Sub getstock_21F()
Dim url, HTMLsourcecode, GetXml
Set HTMLsourcecode = CreateObject("htmlfile")
Set GetXml = CreateObject("msxml2.xmlhttp")
url = "https://goodinfo.tw/StockInfo/StockCashFlow.asp?STOCK_ID=2317&RPT_CAT=M_QUAR"
With GetXml
.Open "GET", url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.send
Do Until .readyState = 4: DoEvents: Loop
HTMLsourcecode.body.innerhtml = .responsetext
Set Table = HTMLsourcecode.all.tags("table")(17).Rows
For i = 2 To Table.Length - 1
For j = 0 To Table(i).Cells.Length - 1
ActiveSheet.Cells(i + 1, j + 1) = Table(i).Cells(j).innertext
Next j
Next i
End With
Set HTMLsourcecode = Nothing
Set GetXml = Nothing
End Sub
Sub postmethod()
Dim HTMLsourcecode, Clipboard As Object
Set HTMLsourcecode = CreateObject("htmlfile")
Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
url = "https://goodinfo.tw/StockInfo/StockCashFlow.asp?STOCK_ID=2317&RPT_CAT=M_QUAR"
url_a = "https://goodinfo.tw/StockInfo/StockCashFlow.asp?STOCK_ID=2317"
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", url_a
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.send
HTMLsourcecode.body.innerhtml = convertraw(.ResponseBody)
With Clipboard
.SetText HTMLsourcecode.body.innerhtml
.PutInClipboard
End With
With Sheets("Raw")
.Select
.Cells.Clear
.Cells(1, 1).Select
.PasteSpecial NoHTMLFormatting:=True
.Columns.ColumnWidth = 10
.Columns(1).ColumnWidth = 20
.Columns(1).WrapText = True
.Cells(1, 1).Select
End With
End With
End Sub
Function convertraw(rawdata)
Dim rawstr
Set rawstr = CreateObject("adodb.stream")
With rawstr
.Type = 1
.Mode = 3
.Open
.Write rawdata
.Position = 0
.Type = 2
.Charset = "utf-8"
convertraw = .ReadText
.Close
End With
Set rawstr = Nothing
End Function
附加壓縮檔: 201801/mobile01-f31e7268cb3df617be4454a3cae97e65.zip
關閉廣告