Office中国论坛/Access中国论坛

标题: 【Access小品】一网打尽---从网页快速提取数据 [打印本页]

作者: todaynew 时间: 2012-8-26 21:00
标题: 【Access小品】一网打尽---从网页快速提取数据
本帖最后由 todaynew 于 2012-8-26 21:13 编辑

　　周末闲来无事，研究了一下WebBrowser控件。很久之前记得红尘同志做过一个天气预报的窗体，前不久海峰同志在解决一个版友的提问时也处理过类似问题。当时感到有些新奇，但没有做深入的研究。最近在做.NET方面的学习，一直觉得用ASP.NET解决网页方面的问题，较之ACCESS来得更为容易一些，便觉得犯不着在Access上折腾与网页有关的问题。今天仔细在网上找了一些与WebBrowser控件有关的资料，觉得可以通过这个控件做一些与网页相关的应用。于是便决定写此例，初步揭示窗体嵌入网页并提取网页数据方面的应用。

　　这个示例以OFFICE中国论坛的Access常规交流版面为数据提取对象，提取论坛的文贴标题及其链接地址。处理这个问题有这么几个要点：

　　１、要在窗体上添加一个WebBrowser控件；

　　２、需要添加两个引用：Microsoft HTML Object Library和Microsoft Internet Controls

　　３、需要用到WebBrowser控件的DocumentComplete事件。注意这个事件在WebBrowser控件属性中是找不到的，可以直接在VBa设计视图下直接书写：Private Sub WebBrowser0_DocumentComplete(ByVal pDisp As Object, URL As Variant)

　　４、对提取的目标网页进行分析找出提取的规律。方法是右击网页，点击“查看源文件”，在打开的源文件代码中找到要提取对象的一些特定的属性，比如class属性或者id属性等。在OFFICE中国论坛的Access常规交流版面的html代码中class设置为“xst”的a标签就是我们要提取的数据。我们只要遍历具有这个特征的a标签，并提取它们的innerText和href就完成任务了。

　　除了这个示例所示的应用外，通过WebBrowser控件及vba代码甚至可以做出编写网页的功能来，所以其应用的方面应该十分广泛，对WebBrowser控件有兴趣的版友可以查看以下地址：http://z.book118.com/009jiaoyuzi ... %C3%BC%BC%C7%C9.htm

Private Sub WebBrowser0_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim doc As IHTMLDocument6
Dim a_tags As IHTMLElementCollection
Dim a_tag As HTMLAnchorElement
Dim txt As String, strhref As String
Dim ssql As String
Dim m As Long
Set doc = Me.WebBrowser0.Document

If InStr(URL, "http://www.office-cn.net/forum-2") > 0 Then
      Set a_tags = doc.all.tags("a")
      m = 0
      For Each a_tag In a_tags
         If a_tag.className = "xst" Then
            txt = a_tag.innerText
            strhref = a_tag.href
            If DCount("*", "文贴表", "标题='" & txt & "'") = 0 Then
                  ssql = "insert into 文贴表 (标题,地址) values ('" & txt & "','" & strhref & "')"
                  CurrentDb.Execute ssql
                  m = m + 1
            End If
         End If
      Next a_tag
      Me.文贴子窗体.Form.Requery
      MsgBox "已自动提取 " & m & " 条记录！"
End If
End Sub

[attach]50251[/attach]

[attach]50252[/attach]

作者: 叶海峰 时间: 2012-8-26 21:08
Web Browser控件还有click,submit等等方法,可以通过这些方法,实现网页grid控件的翻页,提交按钮的点击等等功能.之前曾经做过一次中国药品网的药品资料提取,100多万的记录,全部是用grid控件显示,总共有几千页,通过代码自动一页一页的自动下载下来.

作者: layaman_999 时间: 2012-8-26 22:32
如果使用TeleportPro的话，进行整站拷贝到硬盘，浏览速度超快

作者: xxfwajj84 时间: 2012-8-27 03:53
Dim doc As IHTMLDocument6
这句提示“用户定义类型未定义”
更换为“Dim doc As MSHTML.HTMLDocument”就没有提示了

作者: zhuyiwen 时间: 2012-8-27 08:57
真的不错，我也做过这样傻事，呵呵。

http://z.book118.com/009jiaoyuzi ... %C3%BC%BC%C7%C9.htm

还真的全面！

谢了！

作者: todaynew 时间: 2012-8-27 11:16

xxfwajj84 发表于 2012-8-27 03:53
Dim doc As IHTMLDocument6
这句提示“用户定义类型未定义”
更换为“Dim doc As MSHTML.HTMLDocument”就 ...

IHTMLDocument6可降低为IHTMLDocument3等试试

作者: asklove 时间: 2012-8-30 16:32
真是好东西，收藏了

作者: 软件下载 时间: 2013-11-2 15:28
http://z.book118.com/009jiaoyuzi ... %C3%BC%BC%C7%C9.htm已经失效了。

我用excel的webbrowser做了个采集搜房、58和赶集词源的程序，界面难看，代码感觉挺雍肿，来看看你这个

作者: 软件下载 时间: 2013-11-2 15:43
本帖最后由软件下载于 2013-11-2 15:44 编辑

网站已经改版，我帮你修改了一段代码，现在能正常采集了。
请把下面这段代码替换源代码中的过程

修改处有2个：一是if instr(url...)后面的网址域名有变化。
二是classname多了个“S ”
Private Sub WebBrowser0_DocumentComplete(ByVal pDisp As Object, URL As Variant)

Dim doc As IHTMLDocument6
Dim a_tags As IHTMLElementCollection
Dim a_tag As HTMLAnchorElement
Dim txt As String, strhref As String
Dim ssql As String
Dim m As Long
Me.Text9 = WebBrowser0.LocationURL
Set doc = Me.WebBrowser0.Document
If InStr(URL, "http://www.office-cn.net/forum-2-1") > 0 Then
' MsgBox URL
      Set a_tags = doc.all.tags("a")
      m = 0
   '  Debug.Print a_tags
      For Each a_tag In a_tags
         If a_tag.className = "s xst" Then
            txt = a_tag.innerText
            strhref = a_tag.href
            If DCount("*", "文贴表", "标题='" & txt & "'") = 0 Then
                  ssql = "insert into 文贴表 (标题,地址) values ('" & txt & "','" & strhref & "')"
                  CurrentDb.Execute ssql
                  m = m + 1
            End If
         End If
      Next a_tag
      Me.文贴子窗体.Form.Requery
      MsgBox "已自动提取 " & m & " 条记录！"
End If
End Sub

作者: bjcompass 时间: 2013-11-15 09:19
版主好东西真多，再看一遍还有收获，谢谢

作者: joshey 时间: 2015-2-10 23:39
为什么不能正常提取呢？

作者: joshey 时间: 2015-2-11 16:40
代码作以下调整可以正常提取了。
If InStr(URL, "http://www.office-cn.net/forum-2") > 0 Then
网站表第一项修改为http://www.office-cn.net

作者: nncchh 时间: 2015-7-20 15:58
学习学习，谢谢分享！

作者: joelongma 时间: 2017-8-7 23:03
Private Sub Combo1_AfterUpdate()
Me.WebBrowser0.Navigate Me.Combo1.Column(2)
End Sub
我把这个应用和通用快速开发平台结合了一下，但是这一项，总是会显示错误信息13，这是为什么呢，另外这个navigate 语法是什么意思呀，能把这一句解释一下吗？谢谢了

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)