如何实现自动访问多个URL并按对应规则命名保存网页截图

准备工作 #

• 操作系统为Windows，已安装Excel、任意主流浏览器、Microsoft Paint
• 将所有待访问URL按顺序填入Excel Sheet1的A列，从A1单元格开始填写，无需表头
• 在D盘根目录新建名为网页截图的文件夹，用于存储输出的截图文件

操作步骤 #

1. 打开保存了URL的Excel文件，按下Alt+F11调出VBA编辑界面
2. 左侧工程列表右键点击当前工作簿名称，依次选择「插入」-「模块」
3. 将下方完整代码复制粘贴到右侧空白代码编辑区域
4. 按下F5运行宏，运行过程中请勿操作鼠标键盘，等待所有截图自动生成完毕即可

Sub 批量网页截图()
    Dim 浏览器路径 As String, 截图保存路径 As String, 命名方案 As Integer, 等待秒数 As Integer
    Dim i As Integer, url As String, 文件名 As String, 域名后部分 As String
    
    ' ========== 可自定义参数 开始 ==========
    浏览器路径 = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe" ' 可替换为Chrome/IE路径
    截图保存路径 = "D:\网页截图\"
    命名方案 = 2 ' 1=完整域名替换斜杠命名，2=仅取.com之后部分命名
    等待秒数 = 7 ' 页面加载+全屏提示消失等待时间
    ' ========== 可自定义参数 结束 ==========
    
    i = 1
    Do While Cells(i, 1).Value <> ""
        url = Cells(i, 1).Value
        ' 生成文件名
        If 命名方案 = 1 Then
            文件名 = Replace(Replace(url, "https://", ""), "/", "-") & ".jpg"
        Else
            域名后部分 = Mid(url, InStr(url, ".com/") + 5)
            文件名 = Replace(域名后部分, "/", "-") & ".jpg"
        End If
        
        ' 打开浏览器访问URL
        Shell 浏览器路径 & " -inprivate " & url, vbMaximizedFocus
        Application.Wait Now + TimeValue("00:00:03") ' 等待浏览器启动
        ' 按F11全屏
        Application.SendKeys "{F11}", True
        Application.Wait Now + TimeValue("00:00:" & 等待秒数)
        ' 截取全屏
        Application.SendKeys "^{PRTSC}", True
        Application.Wait Now + TimeValue("00:00:01")
        ' 打开Paint粘贴保存
        Shell "mspaint.exe", vbMaximizedFocus
        Application.Wait Now + TimeValue("00:00:02")
        Application.SendKeys "^v", True
        Application.Wait Now + TimeValue("00:00:01")
        Application.SendKeys "^s", True
        Application.Wait Now + TimeValue("00:00:01")
        Application.SendKeys 截图保存路径 & 文件名, True
        Application.SendKeys "%s", True
        Application.Wait Now + TimeValue("00:00:01")
        ' 关闭Paint和浏览器
        Application.SendKeys "%{F4}", True
        Application.Wait Now + TimeValue("00:00:01")
        Application.SendKeys "%{F4}", True
        Application.Wait Now + TimeValue("00:00:01")
        
        i = i + 1
    Loop
    MsgBox "所有截图已生成完毕，保存路径：" & 截图保存路径
End Sub

常见调整说明 #

• 更换浏览器：修改代码中浏览器路径参数的值为你使用的浏览器exe文件实际路径即可
• 切换命名规则：修改命名方案参数的值，1对应要求的命名方案1，2对应命名方案2
• 调整等待时长：如果页面加载慢，可适当调大等待秒数的数值

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