WebBrowser或IE物件分析網頁表格/自動登入網頁

當需要分析或控制一個網頁時，不論是靜態網頁或是動態網頁，都可以透過WebBrowser或IE物件分析網頁，但是並非每一個網頁資料排列方式都是相同，排列方式需要找尋網頁的原始碼，也就是說需要為不同的網頁量身打造不同的分析程式，以下就以EXCEL來解析網頁！其他語言的用法請用google自行尋找。

範例一：用WebBrowser讀表格
1.工具→巨集→Visual Basic編輯器
2.插入→自定表單→檢視→工具箱→工具箱按右鍵

 

Sub UseWebBrowser() UseWebBrowser()
    Cells.Clear
    Dim sURL As String
    'Dim IE As New InternetExplorer
    Dim hDoc 'As New MSHTML.HTMLDocument
    Dim myWeb
    '設定查尋網頁
    sURL = "http://www.dbmaker.com.tw/stock/cgihistory.cgi?id=1101&begin=2007&end=2100"
    '使用ActiveX-Webrowser讀網頁
    '裝入網址並顯示在activex元件內

    With UserForm1
        Set myWeb = .WebBrowser1

        myWeb.navigate (sURL)
        Do While myWeb.ReadyState <> READYSTATE_COMPLETE '等待網頁loading完成
            DoEvents
        Loop

        '列出網頁中的資料
        Set hDoc = myWeb.Document '引用 Document 對象
        Call ListTableinnertext(hDoc)
        'WebBrowser1.Quit
    End With
    Set hDoc = Nothing
    Set myWeb = Nothing
    UserForm1.Show 0
End Sub

 

Sub ListTableinnertext() ListTableinnertext(oDoc) '分析html
    Dim DocElemsCnt As Integer
    Dim Tbl As Object
    Dim rCol As Integer
    For DocElemsCnt = 0 To oDoc.all.Length - 1
        'tagName:獲取對象的標籤名稱。
        '標題
        If oDoc.all.Item(DocElemsCnt).tagName = "P" Then
            Set Tbl = oDoc.all.Item(DocElemsCnt)
            Sheets(1).Range("A1").Value = Tbl.previousSibling.data
        End If
        If oDoc.all.Item(DocElemsCnt).tagName = "TABLE" Then
            Set Tbl = oDoc.all.Item(DocElemsCnt) '裝入整個項目

            If Tbl.Rows.Length > 10 Then
            'Tbl.Rows.Length:取得TABLE(表格)的列數
                For RwLen = 0 To Tbl.Rows.Length - 1
                    '已知表格資料共有六欄
                    Sheets(1).Range("A3").Offset(RwLen, 0).Value = Tbl.Rows(RwLen).Cells(0).innerText
                    Sheets(1).Range("B3").Offset(RwLen, 0).Value = Tbl.Rows(RwLen).Cells(1).innerText
                    Sheets(1).Range("C3").Offset(RwLen, 0).Value = Tbl.Rows(RwLen).Cells(2).innerText
                    Sheets(1).Range("D3").Offset(RwLen, 0).Value = Tbl.Rows(RwLen).Cells(3).innerText
                    Sheets(1).Range("E3").Offset(RwLen, 0).Value = Tbl.Rows(RwLen).Cells(4).innerText
                    Sheets(1).Range("F3").Offset(RwLen, 0).Value = Tbl.Rows(RwLen).Cells(5).innerText
                Next RwLen
            End If
        End If
    Next DocElemsCnt
End Sub

範例二：用IE讀取網頁表格

Option Explicit
Dim myData() As String

Sub IeApp() IeApp()
    Dim myIe As Object
    Dim myHtmDoc As Object
    Set myIe = CreateObject("InternetExplorer.Application") '開啟ie
    'Dim IE As New InternetExplorer
    Dim DocElemsCnt As Long
    Dim myTable As Object
    Dim myTableRow As Long, myTableCell As Long
    Dim RowLen As Integer, CellLen As Integer
    Dim StartTime As Date, EndTime As Date
    
    Dim myRange As Object
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = False
    Sheets(1).Cells = ""
    Application.StatusBar = "網路連線中請稍候...."
    StartTime = Timer
    myIe.navigate "http://www.dbmaker.com.tw/stock/cgihistory.cgi?id=1101&begin=2007&end=2100"
    myIe.Visible = False
    Do While myIe.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
    EndTime = Timer
    Sheets(1).Range("C1").Value = "讀取網頁"
    Sheets(1).Range("D1").Value = "共花費" & Format(EndTime - StartTime, "00.00") & "秒"
    
    Application.StatusBar = "資料分析中請稍候...."
    StartTime = Timer
    '引用 Document 對象
    Set myHtmDoc = myIe.Document
    '==============================================================================================
    '列出網頁中的資料
    '每一個網頁都不一樣，請依照想要讀取的網頁分析資料！
    
    For DocElemsCnt = 0 To myHtmDoc.all.Length - 1
        DoEvents
        '引用item對象
        Set myTable = myHtmDoc.all.Item(DocElemsCnt)
        'tagName:獲取對象的標籤名稱。
        If myTable.tagName = "P" Then '填入標題
            Sheets(1).Range("A1").Value = myTable.previousSibling.data
        End If
        
        If myTable.tagName = "TABLE" Then 'tagName:若為table，則表示表格。
        myTableRow = myTable.Rows.Length 'Rows.Length:取得TABLE(表格)的行數
        myTableCell = myTable.Rows.Item(CellLen).Cells.Length 'Cell.Length:取得TABLE(表格)的欄數
        
        ReDim myData(myTableRow, myTableCell) As String
            For RowLen = 0 To myTableRow - 1
                For CellLen = 0 To myTableCell - 1
                    '利用巢狀迴圈填入陣列
                    myData(RowLen, CellLen) = myTable.Rows(RowLen).Cells(CellLen).innerText
                    DoEvents
                Next CellLen
                DoEvents
            Next RowLen
        End If
        DoEvents
    Next DocElemsCnt
    '==============================================================================================

    '利用陣列填入Excel，精典方法！必學
    Sheets(1).Range(Cells(3, 1), Cells(RowLen, CellLen)) = myData
    
    EndTime = Timer
    Sheets(1).Range("E1").Value = "分析資料"
    Sheets(1).Range("F1").Value = "共花費" & Format(EndTime - StartTime, "00.00") & "秒"
    Application.StatusBar = "資料已下載完畢........"
    myIe.Quit
End Sub

範例三：自動登入網頁

Option Explicit
Dim myWeb
Sub CommandWeb() CommandWeb()
    Dim sURL As String
    
    sURL = "https://www.google.com/accounts/ServiceLogin?service=mail&passive=true&rm=false&continue=http%3A%2F%2Fmail.google.com%2Fmail%2F%3Fui%3Dhtml%26zy%3Dl&bsv=1k96igf4806cy&ltmpl=default&ltmplcache=2&hl=zh-TW"
    Set myWeb = UserForm1.WebBrowser1
    myWeb.navigate (sURL)
    Do While myWeb.ReadyState <> READYSTATE_COMPLETE '等待網頁loading完成
        DoEvents
    Loop
    Call Login
End Sub

Sub Login() Login()
    Dim vDoc, vTag
    Dim i, C As Integer

    Set vDoc = myWeb.Document

    For i = 0 To vDoc.all.Length - 1 '檢測所有標籤
        If UCase(vDoc.all(i).tagName) = "INPUT" Then '找到input標籤
            Set vTag = vDoc.all(i)

            If vTag.Type = "text" Then '判斷text欄位
                Select Case vTag.Name
                Case "Email" '檢查帳號欄位
                    vTag.Value = "帳號" '請替換成正確的資料
                End Select
            End If
        End If
    Next i

    For i = 0 To vDoc.all.Length - 1 '檢測所有標籤
        If UCase(vDoc.all(i).tagName) = "INPUT" Then '找到input標籤
            Set vTag = vDoc.all(i)

            If vTag.Type = "password" Then '判斷text欄位
                Select Case vTag.Name
                Case "Passwd" '檢查帳號欄位
                    vTag.Value = "密碼" '請替換成正確的資料
                End Select
            End If
        End If
    Next i
    
    myWeb.Document.all("signIn").Click   '看這裡,只要一行
    UserForm1.Show 0
End Sub

執行結果

 讀網頁表格.rar

若有謬誤，煩請告知，新手發帖請多包涵

 

 

 

 

 

参考: http://www.dotblogs.com.tw/yc421206/archive/2008/10/30/5823.aspx

转载于:https://www.cnblogs.com/luyichuan/archive/2012/02/22/2363350.html