Translate (翻譯此網頁)


Training

MVA


codeplex

CodePlex


Study 4

為技術而學,為學習而生!


twMVC

twMVC


好用工具

mindomo


寫信給我

emailtome



 

.Net Tools

Software

最新回應

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

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

 

Sub 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(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()
    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()
    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()
    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

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

2010~2014 C# 第四季



回應

  • Ben 2009/4/12 上午 10:47 回覆

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

    感謝版大的分享,小弟另想請教,目前想到另一個以JS所製作的網頁上去登入並取得其下面某一頁面上幾個欄位的數值,試過版大的方法發現似乎不能作用(無法找到login ID & PW的欄位...等),不曉得版大是否可以建議方向給小弟我摸索(小弟有心想試試看),感激不盡.

  • yc421206 2009/4/12 下午 12:40 回覆

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

    to Ben :

    也許它不叫login ID & PW,你要針對該網頁特性取值

  • hh 2009/12/7 下午 03:16 回覆

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

    請問
    像UserForm1.WebBrowser1 ,vDoc1.all(i).tagName 這些事件和方法,他們的使用規則與語法在哪邊可以找得到呢 ?

  • hh 2009/12/7 下午 04:00 回覆

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

    請問
    html原始碼裡面,如果有一段: <th>answer</th>
    "answer"這個字串,它也不算tag,要如何以VB取得呢 ?

  • David 2010/8/3 下午 12:36 回覆

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

    找了好久, 終於找到了, 萬分感謝!!!!!!!!!!!!!!!!

  • 阿賢 2012/2/22 上午 12:43 回覆

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

    請問一下我要到http://www.az-sportsnet.com/sports/
    這個網站做職棒資料和分析~~~vb6.0要如何寫和做~
    可以教我嗎?~~謝謝!~

  • 余小章 2012/4/23 下午 01:17 回覆

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

    to 阿賢 :
    要教你啥?在实作上有哪些问题?

  • terry 2012/8/13 上午 02:45 回覆

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

    很精彩,好想學好VBA,如想獲取以下的表格"我 的 排 位 表",應如可做呢,最尾的是日期,每次都不同的更新日期,謝謝http://racing.hkjc.com/racing/info/meeting/Racecard/chinese/Local/20120715/ST/1 

  • modelcrazyer 2012/11/17 上午 12:30 回覆

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

    Option Explicit

    Dim myWeb
    Sub CommandWeb()
        Dim sURL As String
        
        sURL = "http://web.pcc.gov.tw/vms/rvlmd/DisabilitiesQueryRV.do"
        Set myWeb = UserForm1.WebBrowser1
        myWeb.navigate (sURL)
        Do While myWeb.ReadyState <> READYSTATE_COMPLETE '等待網頁loading完成
            DoEvents
        Loop
        Call Login
    End Sub
     
    Sub 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 "supplier_name" '檢查帳號欄位
                        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 = "text" Then '判斷text欄位
                    Select Case vTag.Name
                    Case "supplier_no" '檢查帳號欄位
                        vTag.Value = "" '請替換成正確的資料
                    End Select
                End If
            End If
        Next i
        
        myWeb.Document.all("rvlmQueryAll").Click   '看這裡,只要一行
        UserForm1.Show 0
    end sub
    以上是我修改您的程式
    但是到了UserForm1就沒有動作了
    請問該如何修正
  • Amin 2014/7/28 上午 11:07 回覆

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

    請問如何在VBA環境下不使用CreateObject("InternetExplorer.Application")

    只設定引用項目「Microsoft HTML Object Libaray」

    執行以下的程式

    Sub test()
       WebBrowser1.Navigate "http://www.google.com/"
        Do Until WebBrowser1.ReadyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        On Error Resume Next
        WebBrowser1.Navigate "about:blank"
    End Sub

    我試了很多WebBrowser1 物件了,若使用CreateObject("InternetExplorer.Application"),就會變成InternetExplorer物件操作,我需要的是純WebBrowser1 物件來進行操作

  •  2014/8/2 下午 03:20 回覆

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

    您好

    不好意思 

    能否問問您 以下網站 要如何透過VBA 

    http://tmsearch.tipo.gov.tw/TIPO_DR/GoodsIPO.html

    於左欄中的輸入 "沙拉油"

    並按下查詢

    然後再將右側所顯示的表格貼回EXCEL 中

    謝謝您


*標 題:

*姓 名:

 電子郵件: (將不會被顯示)

 個人網頁:

*回應

登入後使用進階評論

Please add 5 and 8 and type the answer here:

Goolge Analytics