vba获取html代码数据,VBA获取网页表格数据

'获取中国地震网的地震信息

Option Explicit

'http://data.earthquake.cn/datashare/globeEarthquake_csn.html

Sub WebInquire()

Dim Url As String

Dim TableNumber As Integer

Dim Sht As Worksheet

Dim Rng As Range

'指定所需网页地址

Url = ""

'指定网页上的表格编号,自已在网页源里测试

'表格是从0开始,一般人工观察获取所需值

TableNumber = 5

'设置要显示网页内容的目标位置

Set Sht = ThisWorkbook.Worksheets(1)

Set Rng = Sht.Range("A1")

Sht.Cells.ClearContents

Call getTableInfor(Url, TableNumber, Rng)

End Sub

'获取网格程序

Sub getTableInfor(Optional Url As String, Optional TableNumber As Integer, Optional Rng As Range)

Dim IE As Object

Dim DocX, TableX, Row, TdGroup

Dim i%, j%

'定义为IE

Set IE = CreateObject("InternetExplorer.Application")

With IE

'调试时可设为显示

.Visible = True

.navigate Url

Do Until .readyState = 4

DoEvents

Loop

End With

'定义数据所在表格号码

Set TableX = IE.document.getElementsByTagName("table")(TableNumber)

'遍历此表的所有行,TD标签.

'在此说明一下TABLE相关属性,ROWS是行数,COLS是列数

'网页集合的计数是从0开始

For i = 0 To TableX.Rows.Length - 1

Set Row = TableX.Rows(i)

'遍历每行所有表格

For j = 0 To Row.Cells.Length - 1

'显示内容,注意在EXCEL里RANGE集合取表格位是从1开始,所以要加1

Rng.Cells(i + 1, j + 1) = Row.Cells(j).innerText

Next

Next

IE.Quit

End Sub

'/转码

Function BinToStr(arrBin, strChrs)

With CreateObject("ADODB.Stream")

.Type = 2

.Open

.Writetext arrBin

.Position = 0

.Charset = strChrs

.Position = 2

BinToStr = .Readtext

.Close

End With

End Function