[發問] 下載問題

spermbank

大家好:
     我想下載如網址http://newmis.twse.com.tw/stock/fibest.jsp?stock=1101的最佳五檔價量資訊揭示。
     因為使用過excel從網站取得外部資料的功能，但是無法讀取，不知道是什麼問題。

    所以想說是否可以在分頁選取股號名稱，啟動巨集，再從如上網址將目前時間所揭示的最佳五檔價量資訊，儲存成csv檔，並將買進、賣出數量加總，顯示於分頁中呢?
    謝謝。

GBKEE

回復 1# spermbank
給你下載的程式碼 ,其餘的問題可察看本討論區的主題,加以組合(自己多練習 vba 會進步)

1. Option Explicit
   
2. Sub 基本市況報導網站()
   
3.     Dim xlVbTable(1 To 2) As Object, R As Integer, C As Integer, i As Variant, Y As Integer
   
4.     With CreateObject("InternetExplorer.Application")
   
5.         .Visible = True
   
6.        .Navigate "http://newmis.twse.com.tw/stock/fibest.jsp?stock=1101"
   
7.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
   
8.         Set xlVbTable(1) = .Document.getElementById("hor-minimalist-a")
   
9.         Set xlVbTable(2) = .Document.getElementById("hor-minimalist-b")
   
10.         On Error Resume Next
    
11.         With ActiveSheet
    
12.             .Cells.Clear
    
13.             Y = 1
    
14.             For i = 1 To 2
    
15.                 For R = 0 To xlVbTable(i).Rows.Length - 1
    
16.                     For C = 0 To xlVbTable(i).Rows(R).all.Length - 1
    
17.                         .Cells(Y, C + 1) = xlVbTable(i).Rows(R).Cells(C).innertext
    
18.                     Next
    
19.                     Y = Y + 1
    
20.                 Next
    
21.             Next
    
22.         End With
    
23.        .Quit
    
24.     End With
    
25. End Sub
    
26.    

複製代碼

spermbank

回復 2# GBKEE


    感謝G大，但是我發現個問題，因為這個網站開啟後，會讀取即時資料，若直接執行巨集，速度過快，會發生""無法每次""資料完全複製至分頁
    我利用Application.Wait Now + TimeValue("00:00:02")來使網址停留2秒等待網頁資料讀入資料再複製至分頁，雖然可以提高一點資料完全複製
    可是還是有時無法完全讀到，是否有什麼判斷方式，還是哪邊有問題呢?謝謝。
   
    若是用Google Chrome是把InternetExplorer.Application改成什麼呢?
    網頁是否不要顯示就複製至分頁呢? 謝謝。

GBKEE

回復 3# spermbank
會發生""無法每次""資料完全複製至分頁,貼上你的程式碼看看

spermbank

回復 4# GBKEE

Option Explicit
Sub 基本市況報導網站()
    Sheets("工作表3").Select
    Dim xlVbTable(1 To 2) As Object, R As Integer, C As Integer, i As Variant, Y As Integer
    With CreateObject("InternetExplorer.Application")
        .Visible = True
       .Navigate "http://newmis.twse.com.tw/stock/fibest.jsp?stock=5490"
        Application.Wait Now + TimeValue("00:00:02")
        Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
        Set xlVbTable(1) = .Document.getElementById("hor-minimalist-a")
        Set xlVbTable(2) = .Document.getElementById("hor-minimalist-b")
        On Error Resume Next
        With ActiveSheet
            .Cells.Clear
            Y = 1
            For i = 1 To 2
                For R = 0 To xlVbTable(i).Rows.Length - 1
                    For C = 0 To xlVbTable(i).Rows(R).all.Length - 1
                        .Cells(Y, C + 1) = xlVbTable(i).Rows(R).Cells(C).innertext
                    Next
                    Y = Y + 1
                Next
            Next
        End With
       .Quit
    End With
End Sub

spermbank

回復 5# spermbank


    若是用Google Chrome是把InternetExplorer.Application改成什麼呢?
    網頁是否不要顯示就複製至分頁呢? 謝謝。

GBKEE

回復 6# spermbank
你的程式碼沒問題
可再說明  會發生""無法每次""資料完全複製至分頁 是什麼情形??
CreateObject("InternetExplorer.Application") 是MicroSoft 的 iexplore.exe
Google Chrome 不適用

wufonna

請問 G大
Busy Or ReadyState  getElementById 是 InternetExplorer.Application 的屬性嗎
我用 F1 找不到
謝謝

spermbank

回復 7# GBKEE


G大您好:
     大概就是如附件兩張圖片所示(讀不到的情況不一定)。
     另外網頁會跑出來能隱藏嗎? 謝謝。
     
     改成開啟網頁多2秒，能夠完整複製機率變90%以上，但是速度上慢2秒也不能完全解決問題。

GBKEE

回復 9# spermbank
VBA 沒有安裝 IE 的說明

1. Option Explicit
   
2. Sub 基本市況報導網站()
   
3.     Dim xlVbTable(1 To 2) As Object, R As Integer, C As Integer, i As Variant, Y As Integer
   
4.    Sheets("工作表3").Select
   
5.    With CreateObject("InternetExplorer.Application")
   
6.        ' .Visible = True
   
7.        .Navigate "http://newmis.twse.com.tw/stock/fibest.jsp?stock=5490"
   
8.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
   
9.         Application.Wait Now + TimeValue("00:00:02")   'IE開啟後再暫停2秒等候下載IE資料
   
10.         Set xlVbTable(1) = .Document.getElementById("hor-minimalist-a")
    
11.         Set xlVbTable(2) = .Document.getElementById("hor-minimalist-b")
    
12.         On Error Resume Next
    
13.         With ActiveSheet
    
14.             .Cells.Clear
    
15.             Y = 1
    
16.             For i = 1 To 2
    
17.                 For R = 0 To xlVbTable(i).Rows.Length - 1
    
18.                     For C = 0 To xlVbTable(i).Rows(R).all.Length - 1
    
19.                         .Cells(Y, C + 1) = xlVbTable(i).Rows(R).Cells(C).innertext
    
20.                     Next
    
21.                     Y = Y + 1
    
22.                 Next
    
23.             Next
    
24.         End With
    
25.        .Quit
    
26.     End With
    
27. End Sub

複製代碼