摘要:WebBrowser或IE物件分析網頁表格/自動登入網頁
當需要分析或控制一個網頁時,不論是靜態網頁或是動態網頁,都可以透過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
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
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
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<mpl=default<mplcache=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
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<mpl=default<mplcache=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
執行結果
若有謬誤,煩請告知,新手發帖請多包涵
Microsoft MVP Award 2010~2017 C# 第四季
Microsoft MVP Award 2018~2022 .NET