新手求助：如何通过Excel或VBA批量抓取指定网页的学校信息

嘿，作为编程新手能想到用自动化解决重复的复制粘贴工作，真的很聪明！我来一步步带你实现这个需求，全程用Excel VBA搞定，不用手动操作~

准备工作：启用VBA并添加必要引用 #

首先得让Excel允许你用VBA，还要加载网页操作需要的库：

• 打开Excel，点击「文件」→「选项」→「自定义功能区」，勾选「开发工具」，点击确定。
• 切换到「开发工具」标签页，点击「Visual Basic」打开VBA编辑器。
• 在编辑器里点击「工具」→「引用」，找到并勾选 Microsoft HTML Object Library 和 Microsoft Internet Controls，点击确定。

第一步：从列表页获取所有学校的详情链接 #

我们先写代码打开目标列表页，把所有蓝色学校名称对应的链接和名称提取出来：

Sub GetSchoolLinks()
    Dim IE As InternetExplorer
    Dim doc As HTMLDocument
    Dim schoolLinks As IHTMLElementCollection
    Dim link As HTMLAnchorElement
    Dim rowNum As Integer
    
    '初始化IE对象
    Set IE = New InternetExplorer
    IE.Visible = True '设为False可以后台运行，新手建议先开着看过程
    
    '打开列表页
    IE.Navigate "https://www.schooland.hk/ss/tsuen-wan"
    
    '等待页面加载完成
    Do While IE.Busy Or IE.ReadyState <> 4
        DoEvents
    Loop
    
    '获取页面文档对象
    Set doc = IE.Document
    
    '找到所有学校名称的链接（这里假设蓝色文字是页面里的特定<a>标签，你可以按F12检查元素调整选择器）
    Set schoolLinks = doc.querySelectorAll("div.school-item a") '示例选择器，需根据实际页面调整
    
    '准备写入Excel的起始行
    rowNum = 2 '第1行写表头
    Sheets("Sheet1").Range("A1:C1") = Array("学校名称", "详情链接", "电话号码")
    
    '遍历每个学校链接，先存名称和链接
    For Each link In schoolLinks
        Sheets("Sheet1").Cells(rowNum, 1).Value = link.innerText
        Sheets("Sheet1").Cells(rowNum, 2).Value = link.href
        rowNum = rowNum + 1
    Next link
    
    '关闭IE并释放资源
    IE.Quit
    Set IE = Nothing
    Set doc = Nothing
    
    MsgBox "学校链接已提取完成！"
End Sub

注意：上面的querySelectorAll("div.school-item a")是示例选择器，你需要打开列表页按F12，找到蓝色学校名称的<a>标签所在的容器，替换成正确的CSS选择器。比如如果学校名称的<a>标签有特定class，就写成".school-name-link"。

第二步：遍历链接爬取详情页的电话号码 #

接下来我们写代码，遍历刚才存好的链接，逐个打开详情页提取电话号码：

Sub GetSchoolDetails()
    Dim IE As InternetExplorer
    Dim doc As HTMLDocument
    Dim lastRow As Integer
    Dim i As Integer
    Dim phoneText As String
    
    Set IE = New InternetExplorer
    IE.Visible = True
    
    '获取已存链接的最后一行
    lastRow = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
    
    For i = 2 To lastRow
        '打开详情页
        IE.Navigate Sheets("Sheet1").Cells(i, 2).Value
        
        Do While IE.Busy Or IE.ReadyState <> 4
            DoEvents
        Loop
        
        Set doc = IE.Document
        
        '提取电话号码（同样需要根据详情页的元素调整选择器）
        '示例：假设电话在带有"contact-tel"类的标签里
        On Error Resume Next '防止找不到元素报错
        phoneText = doc.querySelector(".contact-info .contact-tel").innerText
        '如果上面的选择器不对，试试另一种方式：找包含"电话"字样的元素后获取内容
        'phoneText = doc.getElementsByTagName("strong")(2).NextSibling.nodeValue '根据实际位置调整
        On Error GoTo 0
        
        '把电话写入表格
        Sheets("Sheet1").Cells(i, 3).Value = phoneText
        '加个小停顿，避免频繁请求被网站限制
        Application.Wait Now + TimeValue("00:00:01")
    Next i
    
    IE.Quit
    Set IE = Nothing
    Set doc = Nothing
    
    MsgBox "所有学校信息已爬取完成！"
End Sub

提示：打开详情页按F12，找到电话号码所在的元素，右键→「复制」→「复制选择器」，把复制的内容替换到querySelector()里的参数，这样就能精准定位了。

新手注意事项 #

• 网页结构变化：如果网站更新了页面结构，选择器可能会失效，需要重新检查元素调整代码。
• 防限制：不要一次性爬取太多页面，循环里加的Application.Wait能让程序停顿几秒，避免被网站屏蔽。
• 测试优先：先测试单个链接的爬取，确认能拿到正确信息后再批量运行。

你可以先运行GetSchoolLinks提取所有链接，再运行GetSchoolDetails爬取详情，或者把两个过程合并成一个子程序，一次性完成。

内容的提问来源于stack exchange，提问作者William Chan