Foxtable(狐表)用户栏目专家坐堂 → [求助]从网页上抓取数据


  共有17195人关注过本帖树形打印复制链接

主题:[求助]从网页上抓取数据

帅哥哟,离线,有人找我吗?
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:三尾狐 帖子:732 积分:5491 威望:0 精华:14 注册:2011/8/28 12:49:00
  发帖心情 Post By:2012/5/11 19:58:00 [显示全部帖子]


图片点击可在新窗口打开查看此主题相关图片如下:foxtable获取网页数据.png
图片点击可在新窗口打开查看

 

On Error Goto Qt
Dim ObjIE As Object, Dom As Object, r As Object, i As Long, j As Integer
ObjIE = CreateObject("Internetexplorer.Application")
StatusBar.Message1 = "正在查询网页信息,可能耗时较久,请耐心等待..."
StatusBar.Refresh
With ObjIE
    .Navigate("http://ball365.net/newo/mpk.html?ct=1317477534001") '网址
    Do Until .ReadyState = 4
        Application.DoEvents
    Loop
    Dom = .Document
End With
r = Dom.All.tags("table")(35).Rows
Dim TblName As String = Inputbox("请输入要创建的临时查询表的名称:","输入临时表名","查询结果")
If TblName = "" Then Goto Qt : Return Nothing
StatusBar.Message1 = "正在动态修改表结构..."
StatusBar.Refresh
Dim TblBld As New DataTableBuilder(TblName )
For i = 0 To r(0).Cells.Length
    TblBld.AddDef("列" & i + 1,Gettype(String),250)
Next
TblBld.Build
Dim Tbl As Table = Tables(TblName )
With Tbl
    If r.Length > .Rows.Count Then .Rows.AddNew(r.Length - .Rows.Count)
    Dim ColName As String
    For i = 0 To r.Length - 1
        For j = 0 To r(i).Cells.Length - 1
            ColName = .Cols(j).Name
            .Rows(i)(ColName) = r(i).Cells(j).innerText
        Next
    Next
End With
MainTable = Tbl
StatusBar.Message1 = "数据查询完成..."
StatusBar.Refresh
Msgbox("ok")
Qt:
If Err.Number > 0 Then Msgbox(Err.Number & vbCrlf & Err.Description)
StatusBar.Reset
ObjIE.Quit
ObjIE = Nothing
Dom = Nothing
r = Nothing


[本帖被加为精华]
 回到顶部