VBA 查子链接 check child links

最新推荐文章于 2020-12-18 15:46:00 发布

linzi_0833

最新推荐文章于 2020-12-18 15:46:00 发布

阅读量515

点赞数

本文链接：https://blog.youkuaiyun.com/linzi_0833/article/details/42363861

版权

本文介绍了一个使用VBA编写的简单网页链接爬虫程序。该程序能够从指定的根URL开始，递归地抓取页面上的所有链接，并将它们记录下来。通过设置最大抓取深度，可以有效地避免无限循环，确保程序的稳定运行。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

'2015-01-03 alayong.com
'Reference Library:
' - Microsoft HTML Object Library
' - Microsoft Internet Controls

Dim ori As Range
Dim depth As Long
Const maxDepth As Long = 10
Const rootUrl As String = "please input root url here"
Sub main()
    Set ori = Range("A1")
    CheckLink rootUrl
End Sub
Sub CheckLink(url As String)
    Dim ie As New SHDocVw.InternetExplorer
    Dim ieDoc As MSHTML.HTMLDocument
    Dim link As MSHTML.IHTMLElementCollection
    Dim childLink As MSHTML.HTMLAnchorElement
    
    ie.Visible = False
    depth = depth + 1
    
    ie.Navigate (url)
    Do While ie.Busy
        DoEvents
    Loop
    
    Do Until ie.readyState = SHDocVw.READYSTATE_COMPLETE
        DoEvents
    Loop

    Set ieDoc = ie.Document
    Set link = ieDoc.getElementsByTagName("a")

    For Each childLink In link
        Set ori = ori.Offset(1, 0)
        ori = childLink.href
        If ori Like "*.???" Or ori Like "*home*" Then   'interest link or other condition to avoid dead loop
        Else
            If depth <= maxDepth Then
                CheckLink ori.value
            End If
        End If
    Next childLink
    
    depth = depth - 1
    ie.Quit
End Sub