轉Web資料問題 !!

oliwa

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

GBKEE

回復 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

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

回復 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. '******************
    
11. 
    
12.         '***這段程式碼供尋找第幾個Table為所你要的資料**

複製代碼

如圖為正確 xTable 的查看

下載 (29.6 KB)

2017-3-11 13:59

oliwa

我再試試 , 謝謝......

oliwa

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

GBKEE

回復 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

活頁簿2.zip (16.58 KB)

下載次數: 2

2017-3-12 08:49

檔案如附件 , 請協助 , 謝謝 !!

GBKEE

回復 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

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