VBA获取网页表格数据

最新推荐文章于 2024-07-14 22:18:32 发布

weixin_34161083

最新推荐文章于 2024-07-14 22:18:32 发布

阅读量4.2k

点赞数

文章标签： python

原文链接：https://my.oschina.net/tedzheng/blog/664459

版权

2019独角兽企业重金招聘Python工程师标准>>>

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

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

转载于:https://my.oschina.net/tedzheng/blog/664459