如何用VBA爬取韦氏词典并导出释义等至Excel？代码问题求助

一、修复搜索按钮触发问题 #

你之前的代码错误在于找错了搜索按钮的定位逻辑，韦氏词典首页的搜索可以通过直接提交搜索表单或者定位正确的按钮元素实现：

1. 搜索输入框ID确实是home-search-term，但搜索按钮可通过选择器button[type='submit']定位，或者直接提交包含输入框的表单（表单ID为home-search-form）。
2. 代码里的ie对象未定义，需修正为当前的CreateObject实例。

修正后的搜索触发代码片段：

With .document
    .getElementById("home-search-term").Value = val
    ' 方式1：提交搜索表单
    .getElementById("home-search-form").submit
    ' 方式2：点击搜索按钮
    ' .querySelector("button[type='submit']").Click
End With

二、定位释义、同义词等元素的正确选择器 #

韦氏词典词条页核心内容对应的元素选择器如下：

• 释义：.dtext类（每个释义项是<span class="dtext">）
• 同义词：<ul class="syn-list">下的<li>元素
• 反义词：<ul class="ant-list">下的<li>元素
• 例句：<div class="example-sentences">下的<span class="sentence-text">元素

三、完整的VBA实现代码 #

以下是批量处理A列词汇，将结果写入B-E列的完整代码：

Sub ScrapeMerriamWebster()
    Dim ie As Object
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim word As String
    Dim definitions As String, synonyms As String, antonyms As String, examples As String
    
    Set ws = ThisWorkbook.ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True ' 调试时可见，发布可设为False
    
    For i = 1 To lastRow
        word = Trim(ws.Cells(i, "A").Value)
        If word <> "" Then
            ' 直接访问词条页面，比首页搜索更高效
            ie.navigate "https://www.merriam-webster.com/dictionary/" & Replace(word, " ", "%20")
            ' 等待页面加载完成
            While ie.Busy Or ie.readyState <> 4
                DoEvents
            Wend
            
            With ie.document
                ' 获取释义
                definitions = ""
                For Each elem In .querySelectorAll(".dtext")
                    definitions = definitions & elem.innerText & vbCrLf
                Next
                ws.Cells(i, "B").Value = Left(definitions, Len(definitions) - 1) ' 移除最后一个换行
                
                ' 获取同义词
                synonyms = ""
                On Error Resume Next ' 处理无同义词的情况
                For Each elem In .querySelectorAll(".syn-list li")
                    synonyms = synonyms & elem.innerText & ", "
                Next
                On Error GoTo 0
                ws.Cells(i, "C").Value = IIf(synonyms <> "", Left(synonyms, Len(synonyms) - 2), "无同义词")
                
                ' 获取反义词
                antonyms = ""
                On Error Resume Next ' 处理无反义词的情况
                For Each elem In .querySelectorAll(".ant-list li")
                    antonyms = antonyms & elem.innerText & ", "
                Next
                On Error GoTo 0
                ws.Cells(i, "D").Value = IIf(antonyms <> "", Left(antonyms, Len(antonyms) - 2), "无反义词")
                
                ' 获取例句
                examples = ""
                On Error Resume Next ' 处理无例句的情况
                For Each elem In .querySelectorAll(".example-sentences .sentence-text")
                    examples = examples & elem.innerText & vbCrLf
                Next
                On Error GoTo 0
                ws.Cells(i, "E").Value = IIf(examples <> "", Left(examples, Len(examples) - 1), "无例句")
            End With
        End If
    Next i
    
    ie.Quit
    Set ie = Nothing
    MsgBox "词汇信息提取完成！"
End Sub

代码说明 #

1. 直接访问词条页：相比首页搜索，直接拼接词汇到URL的方式更高效，避免了搜索表单提交的额外步骤。
2. 错误处理：加入On Error Resume Next处理部分词汇无同义词/反义词/例句的情况，防止代码崩溃。
3. 结果写入：将释义、同义词、反义词、例句分别写入B、C、D、E列。

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