使用VBA从URL批量下载PDF至本地文件夹的技术求助

首先修正你原代码中的几个关键错误，然后提供两种可靠的实现方案：

原代码的核心问题 #

1. 路径拼接错误：循环中修改sveloc会导致路径不断叠加（比如第一次生成...\Saved EPCs\file1.pdf，第二次会变成...\Saved EPCs\file1.pdf\file2.pdf），必须每次循环单独构建完整保存路径
2. 字符串语法错误："\".pdf\""是无效写法，正确的PDF后缀拼接应为".pdf"

方案1：直接下载PDF（推荐，无需打开外部程序） #

使用XMLHTTP直接从URL获取PDF内容并写入本地，效率更高且无需依赖PDF阅读器：

Sub DownloadEPCPDFs()
    Dim baseSavePath As String
    Dim fileName As String
    Dim pdfUrl As String
    Dim rowIndex As Long
    Dim fullSavePath As String
    Dim httpObj As Object
    
    ' 初始化基础保存目录，不存在则创建
    baseSavePath = Application.ActiveWorkbook.Path & "\Saved EPCs\"
    If Dir(baseSavePath, vbDirectory) = "" Then
        MkDir baseSavePath
    End If
    
    rowIndex = 7
    Do Until sh01.Cells(rowIndex, 27) = ""
        pdfUrl = sh01.Cells(rowIndex, 27)
        fileName = sh01.Cells(rowIndex, 2)
        ' 处理文件名特殊字符，避免路径错误
        fullSavePath = baseSavePath & Replace(fileName, "/", "-") & ".pdf"
        
        ' 创建HTTP请求对象
        Set httpObj = CreateObject("MSXML2.XMLHTTP")
        httpObj.Open "GET", pdfUrl, False
        httpObj.send
        
        ' 保存PDF文件
        If httpObj.Status = 200 Then
            Open fullSavePath For Binary As #1
            Put #1, , httpObj.responseBody
            Close #1
            Debug.Print "已保存: " & fullSavePath
        Else
            Debug.Print "下载失败: " & pdfUrl & " (状态码: " & httpObj.Status & ")"
        End If
        
        Set httpObj = Nothing
        rowIndex = rowIndex + 1
    Loop
End Sub

方案说明 #

• 自动检查并创建目标文件夹Saved EPCs
• 替换文件名中的非法字符（如/），避免路径报错
• 无需打开浏览器或PDF阅读器，后台完成下载

方案2：控制Acrobat保存已打开的PDF（需安装Adobe Acrobat完整版） #

如果必须通过FollowHyperlink打开PDF，可以通过控制Acrobat应用程序自动保存：

Sub SaveOpenedEPCPDFs()
    Dim baseSavePath As String
    Dim fileName As String
    Dim pdfUrl As String
    Dim rowIndex As Long
    Dim fullSavePath As String
    Dim acroApp As Object
    Dim acroDoc As Object
    
    baseSavePath = Application.ActiveWorkbook.Path & "\Saved EPCs\"
    If Dir(baseSavePath, vbDirectory) = "" Then
        MkDir baseSavePath
    End If
    
    ' 初始化Acrobat应用
    Set acroApp = CreateObject("AcroExch.App")
    
    rowIndex = 7
    Do Until sh01.Cells(rowIndex, 27) = ""
        pdfUrl = sh01.Cells(rowIndex, 27)
        fileName = sh01.Cells(rowIndex, 2)
        fullSavePath = baseSavePath & Replace(fileName, "/", "-") & ".pdf"
        
        ' 打开PDF链接
        ThisWorkbook.FollowHyperlink pdfUrl
        ' 等待PDF加载完成，可根据网络速度调整等待时间
        Application.Wait Now + TimeValue("00:00:05")
        
        ' 获取当前激活的PDF文档
        Set acroDoc = acroApp.GetActiveDoc
        If Not acroDoc Is Nothing Then
            acroDoc.Save 1, fullSavePath ' 1 = SaveAs模式
            acroDoc.Close
            Debug.Print "已保存: " & fullSavePath
        Else
            Debug.Print "无法获取PDF文档: " & pdfUrl
        End If
        
        rowIndex = rowIndex + 1
    Loop
    
    ' 关闭Acrobat应用
    acroApp.Exit
    Set acroDoc = Nothing
    Set acroApp = Nothing
End Sub

方案说明 #

• 要求安装Adobe Acrobat完整版（Reader无法支持自动化操作）
• 需设置合理的等待时间，确保PDF完全加载后再执行保存操作

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