以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  [求助]从网页上抓取数据  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=19482)

--  作者:blackzhu
--  发布时间:2012/5/11 14:18:00
--  [求助]从网页上抓取数据

老大,我在Excel的论坛找到一段VB  可以从网页上抓取数据的代码,怎么整合到狐表中?

 

   Option Explicit
Sub a()
Dim ie1 As Object, dmt As Object, r As Object, i As Long, j As Long
\'Load UserForm1
\'UserForm1.Show 0
[a1].CurrentRegion.Clear
Cells.NumberFormat = "@"
Set ie1 = UserForm1.WebBrowser1
With ie1
  .Navigate "http://ball365.net/newo/mpk.html?ct=1317477534001" \'网址
  Do Until .ReadyState = 4
    DoEvents
  Loop
  Set dmt = .Document
End With
Application.ScreenUpdating = False
Set r = dmt.All.tags("table")(35).Rows
For i = 0 To r.Length - 1
   For j = 0 To r(i).Cells.Length - 1
        Cells(i + 1, j + 1) = r(i).Cells(j).innerText
   Next
Next
Application.ScreenUpdating = True
Set ie1 = Nothing
Set dmt = Nothing
Set r = Nothing
[a1].CurrentRegion.Columns.AutoFit
End Sub


--  作者:blackzhu
--  发布时间:2012/5/11 14:19:00
--  

网页的原出处:

 

  http://club.excelhome.net/thread-807709-1-1.html


--  作者:狐狸爸爸
--  发布时间:2012/5/11 14:40:00
--  

呵呵,我不会。


--  作者:blackzhu
--  发布时间:2012/5/11 15:05:00
--  
有谁会,飞大师在哪儿?
--  作者:飞
--  发布时间: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


--  作者:狐狸爸爸
--  发布时间:2012/5/12 8:49:00
--  
学习
--  作者:hanxuntx
--  发布时间:2012/5/12 9:13:00
--  

膜拜飞大师

老朱或者飞大师能不能解释下这段代码用在什么类型的网页啊

 

[此贴子已经被作者于2012-5-12 9:14:14编辑过]

--  作者:lihe60
--  发布时间:2012/5/12 9:25:00
--  
江山代有人才出。
--  作者:blackzhu
--  发布时间:2012/5/12 9:57:00
--  
寒寻,不懂.我懂的话就不问了.
--  作者:lihe60
--  发布时间:2012/5/12 12:40:00
--  
以下是引用天问者在2012-5-12 9:33:00的发言:

顶  

暂时没精力学这么技术    (强攻数据流程操作架构这方面的技术中,最近看了一家德国公司开发的ERP系统,实在是牛逼)

把这个erp传到论坛上。