2017年6月14日 星期三

Excel VBA 抓HTML 中的全部Table




Option Explicit
Sub Ex()
    Dim D  As Object, i As Integer, URL As String
    URL = "http://goodinfo.tw/StockInfo/StockDividendPolicy.asp?STOCK_ID=2330"
    'URL = "http://www.goodinfo.tw/stockinfo/StockSorter.asp?"
    With CreateObject("InternetExplorer.Application")
        .Navigate URL
        .Visible = True
         Do While .ReadyState <> 4 Or .Busy
            DoEvents
        Loop
   
        Set D = .document.getElementsByTagName("table")
        ActiveSheet.Cells.Clear
        For i = 0 To D.Length - 1
            Ep i, D(i).outerHTML
        Next
        .Quit
    End With
End Sub


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


Private Sub Ep(i As Integer, S As String)
    Dim R
    With CreateObject("InternetExplorer.Application")
        .Navigate "about:Tabs"
        .Visible = True
        .document.body.innerhtml = S
        .ExecWB 17, 2       '  Select All
        .ExecWB 12, 2       '  Copy selection
        With ActiveSheet
            R = IIf(.UsedRange.Rows.Count = 1, 1, .UsedRange.Rows.Count + 2)
            .Cells(R, 1) = "第 " & i & " 個 Table"
            .Cells(R, 1).EntireRow.Interior.Color = vbYellow
            .UsedRange.Cells(R + 1, 1).Select
            .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
        End With
        .Quit
    End With
End Sub

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

資料來源:
http://forum.twbts.com/thread-12273-1-1.html

沒有留言:

張貼留言