【Access小品】一网打尽---从网页快速提取数据

时　间:2012-08-26 21:09:53
作　者:煮江品茶   ID：10802  城市：武汉
摘　要:【Access小品】一网打尽---从网页快速提取数据。
正　文:

　　周末闲来无事，研究了一下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/009jiaoyuziliao/005/WebBrowser%CA%B9%D3%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.access-cn.com/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

附   件:

点击下载此附件