GBKEE

回復 40# bioleon69

1. Option Explicit
   
2. Sub test()
   
3. Dim Ie As Object, e As Object, R As Integer, C As Integer
   
4.     'Set Ie = CreateObject("InternetExplorer.Application")
   
5.     With CreateObject("InternetExplorer.Application")
   
6.          '.Visible = True
   
7.         .Navigate "http://mops.twse.com.tw/mops/web/t56sb21_q3"
   
8.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
   
9.        '**************************************
   
10.         With .Document.forms("form1")
    
11.             .typek.Value = "otc"
    
12.             .Year.Value = "105"
    
13.             .smonth.Value = "03"
    
14.             .emonth.Value = "04"
    
15.         End With
    
16.       ''******************************************
    
17.         For Each e In .Document.ALL.TAGS("input")
    
18.             If e.Type = "button" And e.Value = " 查詢 " Then e.Click
    
19.         Next
    
20.         '*****************************************
    
21.         Do
    
22.             DoEvents
    
23.             Set e = .Document.ALL("TABLE01").ALL.TAGS("TABLE")(0)
    
24.         Loop Until Not e Is Nothing
    
25.         資料寫入 e
    
26.             .Quit
    
27.     End With
    
28. End Sub
    
29. Sub Ex()
    
30.     With CreateObject("InternetExplorer.Application")
    
31.         .Navigate "http://mops.twse.com.tw/mops/web/t56sb21_q3?encodeURIComponent=1&run=Y&step=1&TYPEK=sii&year=105&smonth=01&emonth=02&sstep=1&firstin=true"
    
32.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
33.         資料寫入 .Document.ALL("TABLE01").ALL.TAGS("TABLE")(0)
    
34.             .Quit
    
35.     End With
    
36. End Sub
    
37. Private Sub 資料寫入(ByVal xTable As Object)
    
38.     Dim R As Integer, C As Integer
    
39.     With ActiveSheet
    
40.             .UsedRange.Clear
    
41.             Application.ScreenUpdating = False
    
42.             For R = 0 To xTable.Rows.Length - 1
    
43.                 For C = 0 To xTable.Rows(R).Cells.Length - 1
    
44.                     .Cells(R + 1, C + 1) = xTable.Rows(R).Cells(C).INNERTEXT
    
45.                 Next
    
46.             Next
    
47.              .UsedRange.WrapText = False
    
48.              Application.ScreenUpdating = True
    
49.     End With
    
50. End Sub

複製代碼

bioleon69

回復 41# GBKEE
G大,第一段程式的FOR EACH那邊確實可以模擬點擊
小弟先收下了!!
---------------------
第一段(test)的應該是您回應我如何模擬點擊吧
以這個例子而言,似乎沒辦法從主搜尋網址
http://mops.twse.com.tw/mops/web/t56sb21_q3
模擬點擊後,直接在抓下面的table資料
而必須從
http://mops.twse.com.tw/mops/web/t56sb21_q3?encodeURIComponent=1&run=Y&step=1&TYPEK=sii&year=105&smonth=01&emonth=02&sstep=1&firstin=true
去抓資料
之後的第二段(ex)跟第三段(資料寫入)才是一個網抓對吧?(小弟理解)

---------------------

Private Sub 資料寫入(ByVal xTable As Object)
這個byval不是很懂,為何不直接dim到sub裡面?

以下是小弟自己最大理解能力的寫法,也是沒辦法成功寫入
還請G大幫忙指正一下錯誤,謝謝您^^"

1. Sub test()
   
2. '*****************************************
   
3. Dim Ie
   
4.     Set Ie = CreateObject("InternetExplorer.Application")
   
5.     With Ie
   
6.        'Visible = True
   
7.         .Navigate "http://mops.twse.com.tw/mops/web/t56sb21_q3?encodeURIComponent=1&run=Y&step=1&TYPEK=sii&year=105&smonth=01&emonth=02&sstep=1&firstin=true"
   
8.         Do Until .readyState = 4
   
9.             DoEvents
   
10.         Loop
    
11. '*****************************************
    
12.         Set cc = .Document.body
    
13.         Set tb = cc.all.tags("table")(0).Rows '定義表格為陣列
    
14.         'Debug.Print tb.innertext              '除錯用
    
15. '*****************************************
    
16.          With ActiveSheet
    
17.         .UsedRange.Clear
    
18.         For i = 0 To tb.Length - 1
    
19.         For j = 0 To tb(i).Cells.Length - 1
    
20.         .Cells(i + 1, j + 1) = tb(i).Cells(j).innertext '逐一寫入
    
21.         Next
    
22.         Next
    
23.         End With
    
24.     End With
    
25.     Ie.Quit
    
26.     Set Ie = Nothing
    
27. End Sub

複製代碼

GBKEE

回復 42# bioleon69

1. Set tb = cc.all.tags("table")(12).Rows

複製代碼

對於 byval不是很懂!可參考VBA的說明.
Sub 陳述式
有效率地傳遞引數

bioleon69

回復 43# GBKEE

ok了!謝謝g大 愛您~^^


byval目前就先不考慮了= =||

ABK

請教一下!    我想下載http://isin.twse.com.tw/isin/C_public.jsp?strMode=2    上面的資料， 使用white5168大的 VBA碼， 出現"Class WorksheetSpecial方法失敗"。請問是哪裡有問題?


Sub Test()
    Const url As String = "http://isin.twse.com.tw/isin/C_public.jsp?strMode=2"
    Cells.Clear
    Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
    With ie
        .Visible = False 'True為開啟ie, False為不開啟ie
        .Navigate url
        Do While .ReadyState <> 4 '等待網頁開啟
            DoEvents
        Loop
        .ExecWB 17, 2 'Select All
        .ExecWB 12, 2 'Copy selection
        Sheets("工作表1").Cells.Select
        Range("A1").Activate
        ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
                False, NoHTMLFormatting:=True
    End With
    Columns("A:B").Delete
    ie.Quit
    MsgBox "資料複製結束"
End Sub

下載 (75.46 KB)
錯誤訊息

2017-6-26 16:20

ABK

解決了!

討論區內找到一篇 相關的貼文
[上市個股日成交資訊下載改版建議]
http://forum.twbts.com/viewthrea ... amp;from=indexheats

由該篇 joey0415大 提供的 VBA碼 小改一下就OK了!


Sub 股票代碼更新()

    Cells.Clear
    surl = "http://isin.twse.com.tw/isin/C_public.jsp?strMode=2"
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & surl, Destination:=Range("$A$1"))
        .Refresh BackgroundQuery:=False
    End With
   
   
End Sub