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

peter624 wrote:
發生物件不支援屬性和方法(恕刪)

peter624 wrote:
另請問大大，Url是從檢視工具觀察到的嗎(chrome按F12)
Url = "https://www.tpex.org.tw/web/stock/statistics/monthly/monthly_rpt_mkt_info_result.php?l=zh-tw&t=5&sd=" & sd & "&ed=" & ed & "&_="(恕刪)

snare wrote:
Jsondata.w...(恕刪)

alantsai5840 wrote:
306樓的 Wantgoo.xlsm(old1 ; new1) 檔 最近執行 又分別出現
執行階段錯誤-2147417848(80010108) Automation錯誤
沒有設定物件變數或 with 區塊變數
看程式又沒問題
不知網站是改變問題 ?
... (恕刪)

'下載需要2個cookies，1個token，3個參數，1個jschl_answer
'但是jschl_answer，需要改用vba計算

'一、先進網站取得r, jschl_vc, pass，cookies
'二、用regexp把網頁原始碼中的java算式拆出來
'三、用vba+eval算出jschl_answer
'四、等5秒(其實網頁原始碼中是4秒)
'五、用取得的參數、網址開始下載
'之後只要程式不結束，速度都跟原本沒保護時一樣快

'java公式是什麼呢?看到圖片中那些!+[]+!![]+!![]+!![]+!![]+!![]，那些就是算式
'(像這個(!+[]+!![]+!![]+!![]+!![]+!![])算出來是=6)
'但是原始碼中的變數、算式，是隨機的，所以要用regexp拆解
'最後要算出 a.value = (+BtZfvqK.bTtid + t.length)
'BtZfvqK是隨機變數，其中t.length就是網址長度，可以定值代替


 url_a = "https://www.wantgoo.com/stock/astock/agentstat?stockno=" & stock & "&type=3.5"
    Set Xmlhttp = CreateObject("Msxml2.XMLHTTP")
    
    With Xmlhttp
       .Open "GET", url_a, False
       .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
       .send
       HtmlSourceCode.body.innerhtml = .responseText
        
       Dim PostData, url_c As String, r As String, jschl_vc As String, pass As String, jschl_answer As String
       Dim decode_jschl_answer As Object, Get_formula As Object
       Set Get_formula = CreateObject("VBScript.RegExp")
       Set decode_jschl_answer = CreateObject("HtmlFile")
       decode_jschl_answer.write "＜script＞document.jschl=function （s） ｛return eval（很長的算式保留）＜／script＞"
       
       
       PostData = HtmlSourceCode.getelementbyid("challenge-form")
       url_c = "https://www.wantgoo.com" & PostData.form.Action
       
       r = PostData.form.Item(0).Value
       jschl_vc = PostData.form.Item(1).Value
       pass = PostData.form.Item(2).Value
        
       With Get_formula
        .Pattern 保留
         程式碼保留
       End With
       
       jschl_answer=很長的算式保留
      程式碼保留  
      
       .send "r=" & r & "&jschl_vc=" & jschl_vc & "&pass=" & pass & "&jschl_answer=" & jschl_answer
      程式碼保留        

Sub test()
        
    Dim Ie As Object, Url As String, stock As String, table, i As Integer, j As Integer
    
    ActiveSheet.Cells.Clear
    Application.ScreenUpdating = False
    
    Set Ie = CreateObject("InternetExplorer.Application")
    Url = "https://www.wantgoo.com/"
    
    stock = InputBox("股票代號", , "2317")
    If stock = "" Then Exit Sub
    
    With Ie
        .Visible = True
        .Navigate Url
        Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
        
        Application.Wait (Now + TimeValue("0:00:10")) '等待ddos防護時間，需大於5秒
        
'for........  如果需要多筆查詢，請從這裡加上迴圈，只需改變stock參數

        .Navigate "https://www.wantgoo.com/stock/astock/agentstat?stockno=" & stock & "&type=3.5"
        Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
        
        .document.all.Item("txtDaysDefine_s").Value = "2019/11/21" '開始日期
        .document.all.Item("txtDaysDefine_e").Value = "2019/12/12" '結束日期
        .document.all.Item("btnDaysDefine").Click
        Application.Wait (Now + TimeValue("0:00:8")) '等待查詢結果，視電腦效能、網路狀態，修改適合時間
        
        Set table = .document.getelementsbytagname("table")(0).Rows
        For i = 0 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
'這𥚃分成2個表格，方便閱讀，可自行用迴圈合併成一個
        Set table = .document.getelementsbytagname("table")(1).Rows
        For i = 0 To table.Length - 1
            For j = 0 To table(i).Cells.Length - 1
                ActiveSheet.Cells(i + 1, j + 1 + 5) = table(i).Cells(j).innertext
            Next j
        Next i
        ActiveSheet.Cells.Columns.AutoFit
        
'next ........ 多筆查詢迴圈結束

    End With
    
    
    Ie.Quit
    Set Ie = Nothing
    Set table = Nothing
        
    Application.ScreenUpdating = True
        
End Sub

snare wrote:
因為網站加上了ddo...(恕刪)</block

snare大大請問

上面的網站，有關卷商的html table也是用json嗎
url_a = "https://www.wantgoo.com/stock/astock/agentstat?stockno=" & stock & "&type=3.5"

玩股網好像又沒有ddos的防護機制了，又有改版了嗎。

peter624 wrote:
上面的網站，有關卷商的html table也是用json嗎
url_a = "https://www.wantgoo.com/stock/astock/agentstat?stockno=" & stock & "&type=3.5"
玩股網好像又沒有ddos的防護機制了，又有改版了嗎。
(恕刪)

lpviva wrote:
在下載74樓的巨集在自己電腦執行後遇到了set table設定的問題
...(恕刪)