Board logo

標題: 轉Web資料問題 !! [打印本頁]
作者: oliwa    時間: 2017-3-11 00:23     標題: 轉Web資料問題 !!

http://www.twse.com.tw/ch/trading/exchange/FMNPTK/FMNPTKMAIN.php
使用此網頁查詢個股的年度交易資料 ,
因網頁改版 , 原本的程式已無法抓出資料轉至Excel中 ,
搭配 Fiddler 查詢 post 時的 URL , 但都無法轉出內容 , 全都是空的滴 ,
求解 , TKS !!
作者: GBKEE    時間: 2017-3-11 08:30

回復 1# oliwa

試試看
  1. Option Explicit
  2. 'http://www.twse.com.tw/ch/trading/exchange/FMNPTK/FMNPTKMAIN.php
  3. '<input name="CO_ID" type="text" size="8" value="2303">
  4. '<input name="query-button" type="submit" class="board" value="查詢" onclick="submitForm($CO_ID)">
  5. Sub Ex_TWSE臺灣證券交易所個股年成交資訊()
  6.     Dim Co_Id As String, xTable As Object, Sh As Worksheet, R As Integer, C As Integer, i As Integer, ii As Integer
  7.     Co_Id = InputBox("請輸入股票代碼 ")
  8.     With CreateObject("InternetExplorer.Application")
  9.         .Visible = True           '**網頁不顯示   .Visible = False
  10.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/FMNPTK/FMNPTKMAIN.php?&CO_ID=" & Co_Id
  11.         Do While .Busy Or .readyState <> 4: DoEvents: Loop     '等候網頁宰入完整
  12.         .Document.ALL("query-button").Click                           '網頁上按下查詢鍵
  13.         Do While .Busy Or .readyState <> 4: DoEvents: Loop     '等候網頁宰入完整
  14.         Set xTable = .Document.ALL.TAGS("Table")                 '設定變數為網頁 tagname "Table"的物件集合
  15.         '***這段程式碼供尋找第幾個Table為所你要的資料**
  16.        ' For i = 0 To xTable.Length - 1   'Length 網頁物件集合計算子物件的函數
  17.        '     MsgBox "第" & i & "個資料" & vbLf & xTable(i).innertext '**查看你要的資料為第幾個Table
  18.        ' Next
  19.         '************************************
  20.         Set Sh = Sheets("SHEET1")       '指定工作頁
  21.         Sh.UsedRange.Clear                  '清除工作頁
  22.         '*******讀取資料的程式碼******************
  23.         ii = 1
  24.         For i = 3 To 4
  25.             If InStr(xTable(i).innertext, "查無資料！") Then MsgBox xTable(i).innertext:  .Quit: Exit Sub
  26.             For R = 0 To xTable(i).Rows.Length - 1                        '
  27.                 For C = 0 To xTable(i).Rows(R).Cells.Length - 1
  28.                     Sh.Cells(R + ii, C + 1) = xTable(i).Rows(R).Cells(C).innertext
  29.                 Next
  30.             Next
  31.             ii = R + 2
  32.         Next
  33.         '****************************************************
  34.         With Sh
  35.             Co_Id = .[a1]
  36.             .[a1] = ""
  37.             .UsedRange.Columns.AutoFit        '**AutoFit 方法 將範圍中的欄寬和列高調整為最適當的值。
  38.             .[a1] = Co_Id
  39.         End With
  40.         .Quit        '關閉網頁
  41.     End With
  42. End Sub
複製代碼
作者: oliwa    時間: 2017-3-11 12:03

Option Explicit
'http://www.twse.com.tw/ch/trading/exchange/FMNPTK/FMNPTKMAIN.php
'<input name="CO_ID" type="text" size="8" value="2303">
'<input name="query-button" type="submit" class="board" value="查詢" onclick="submitForm($CO_ID)">

Sub TT()
    Dim Co_Id As String, xTable As Object, Sh As Worksheet, R As Integer, C As Integer, i As Integer, ii As Integer
    'Co_Id = stock_no
    Co_Id = InputBox("Input Stock No")
   
    With CreateObject("InternetExplorer.Application")
        .Visible = True     '**網頁不顯示 .Visible = False
        .Navigate "http://www.twse.com.tw/ch/trading/exchange/FMNPTK/FMNPTKMAIN.php?&CO_ID=" & Co_Id
        
        Do While .Busy Or .readyState <> 4: DoEvents: Loop '等候網頁宰入完整
            .Document.ALL("query-button").Click            '網頁上按下查詢鍵
               
        Do While .Busy Or .readyState <> 4: DoEvents: Loop    '等候網頁宰入完整
        Set xTable = .Document.ALL.TAGS("Table")        '設定變數為網頁 tagname "Table"的物件集合

        '***這段程式碼供尋找第幾個Table為所你要的資料**
        'For i = 0 To xTable.Length - 1? ?'Length 網頁物件集合計算子物件的函數
        'MsgBox "第" & i & "個資料" & vbLf & xTable(i).innertext '**查看你要的資料為第幾個Table
        ' Next
        '************************************

        Set Sh = Sheets("temp") '指定工作頁
        Sh.UsedRange.Clear      '清除工作頁

        '*******讀取資料的程式碼******************
        ii = 1
        For i = 3 To 4
            If InStr(xTable(i).innertext, "查無資料！") Then MsgBox xTable(i).innertext: .Quit: Exit Sub

            For R = 0 To xTable(i).Rows.Length - 1
                For C = 0 To xTable(i).Rows(R).Cells.Length - 1
                    Sh.Cells(R + ii, C + 1) = xTable(i).Rows(R).Cells(C).innertext
                Next
            Next
        ii = R + 2

        Next

    '****************************************************
    With Sh
        Co_Id = .[a1]
        .[a1] = ""
        .UsedRange.Columns.AutoFit  '**AutoFit 方法 將範圍中的欄寬和列高調整為最適當的值。
        
        .[a1] = Co_Id
    End With
   
    .Quit  '關閉網頁
   
    End With
End Sub


執行後出現錯誤在  If InStr(xTable(i).innertext, "查無資料！") Then MsgBox xTable(i).innertext: .Quit: Exit Sub
請那語法有誤 ? 謝謝
作者: GBKEE    時間: 2017-3-11 13:59

本帖最後由 GBKEE 於 2017-3-11 14:00 編輯

回復 4# oliwa
2003版沒有錯誤
  1.   .Document.ALL("query-button").Click                           '網頁上按下查詢鍵
  2.         Do While .Busy Or .readyState <> 4: DoEvents: Loop     '等候網頁宰入完整
  3.         '******加入這段程式碼試試看---應是網路頻寬速度慢於程式執行的速度*****
  4.         Do
  5.             Set xTable = .Document.ALL.TAGS("Table")                 '設定變數為網頁 tagname "Table"的物件集合
  6.             DoEvents
  7.         Loop Until xTable.Length = 6
  8.                Application.VBE.Windows("區域變數").Visible = True  '查看沒錯誤這行程式碼可珊掉
  9.         Stop                                                                              '查看沒錯誤這行程式碼可珊掉
  10. '******************

  12.         '***這段程式碼供尋找第幾個Table為所你要的資料**
複製代碼
如圖為正確 xTable 的查看


[attach]26794[/attach]
作者: oliwa    時間: 2017-3-11 17:03

我再試試 , 謝謝......
作者: oliwa    時間: 2017-3-11 19:59

目前使用 office 365 , 有更新所以應該是 2016 版 ,
IE 資料網頁有開啟 , 而且不用按畫面也能帶出資料 ,
只是抄寫至 sheet 時仍沒有成功 , 完全是空白滴.......
作者: GBKEE    時間: 2017-3-12 08:11

回復 6# oliwa
附欓上來,請有高於2003版者幫忙除錯
   
  1. Do
  2.             Set xTable = .Document.ALL.TAGS("Table")                 '設定變數為網頁 tagname "Table"的物件集合
  3.             DoEvents
  4.         Loop Until xTable.Length = 6
  5.                Application.VBE.Windows("區域變數").Visible = True  '查看沒錯誤這行程式碼可珊掉
  6.         Stop                  '查看沒錯誤這行程式碼可珊掉
複製代碼

4#所加入的程式碼 執行到Stop, 程式會暫停 區域變數視窗中有看到 xTable.Length = 6 嗎?
如有表示資料有抓到, 按F5程式繼續執行下去,資料就出來了
作者: oliwa    時間: 2017-3-12 08:51

[attach]26797[/attach]
檔案如附件 , 請協助 , 謝謝 !!
作者: GBKEE    時間: 2017-3-12 09:17

回復 8# oliwa
  1. Sub TT(stockNo As String)
  2.     Dim xTable As Object, Sh As Worksheet, R As Integer, C As Integer, i As Integer, ii As Integer
  3.     'Co_Id = stock_no
  4.     'Co_Id = stockNo
  5.     With CreateObject("InternetExplorer.Application")
  6.         .Visible = True     '**網頁不顯示 .Visible = False
  7.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/FMNPTK/FMNPTKMAIN.php?download=csv&CO_ID=" & stockNo
  8.                                                                                                                                                                          '**直接給上***
  9.                                                                                                                                                                         
  10.         Do While .Busy Or .readyState <> 4: DoEvents: Loop '等候網頁載入完整
  11.             .Document.ALL("query-button").Click     '網頁上按下查詢鍵
  12.         '***附欓沒有Click後,再一次 等候網頁載入完整***
  13.         Do While .Busy Or .readyState <> 4: DoEvents: Loop '等候網頁宰入完整
  14.         '*********************************************
  15.         Do
  16.             Set xTable = .Document.ALL.TAGS("Table")               '設定變數為網頁 tagname "Table"的物件集合
  17.             DoEvents
  18.         Loop Until xTable.Length = 6
複製代碼
作者: oliwa    時間: 2017-3-13 09:51

修正後仍沒有正確抄錄資料 ,
中斷後 , 發現都在 DoEvents 那 ,
並沒有繼續往下執行 , 所以還沒有到抄錄資料的程式.....
這是因為轉錄到"Table"作業未完成 , 還是它一直在循環中 ?
這部分可以如何修正 ? 謝謝....
作者: GBKEE    時間: 2017-3-14 06:12

回復 10# oliwa

有請高於2003版者幫忙除錯
作者: joey0415    時間: 2017-3-14 15:18

本帖最後由 joey0415 於 2017-3-14 15:20 編輯

回復 9# GBKEE

測試環境  WIN 7 32  位元  OFFICE 2010

若使用F8測試，第三個TALBE 有內容
[attach]26809[/attach]
若按F5，則第三個TABLE沒有內容
若加上 SLEEP 測試也是一樣

附上小弟可以執行的程式碼：
  1. Sub 巨集1()
  2.    
  3.     Cells.Clear
  4.     SURL = "http://www.twse.com.tw/ch/trading/exchange/FMNPTK/FMNPTKMAIN.php"
  5.     SN = "2002"
  6.     Set MYQT = ActiveSheet.QueryTables.Add(Connection:="URL;" & SURL, Destination:=Range("$A$1"))
  7.     With MYQT
  8.         .PostText = "download=&CO_ID=" & SN
  9.         .Refresh BackgroundQuery:=False
  10.         .Delete
  11.     End With
  12.     Set MYQT = Nothing
  13. End Sub
複製代碼
作者: GBKEE    時間: 2017-3-15 05:50

回復 12# joey0415

謝謝你
作者: oliwa    時間: 2017-3-16 15:24

採用 joey0415 的方法 , 資料可以轉出來了 ,
感謝二位的協助 .......



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)