求助：编写VBA脚本从Excel URL列表下载文件至指定文件夹

原代码的核心问题有两个：

1. FilePath 仅指定了文件夹路径，未包含具体文件名，SaveToFile 方法需要完整的文件路径（文件夹+文件名）才能正确保存文件
2. 依赖 ActiveCell 遍历单元格，稳定性差，易因手动操作中断执行

以下是修正后的代码：

Sub downloadFile()
    Dim fso As Object
    Dim oWinHttp As Object
    Dim oStream As Object
    Dim URL As String, FilePath As String, folderPath As String
    Dim ws As Worksheet
    Dim currentRow As Long
    Dim fileName As String
    
    ' 指定目标工作表，避免依赖激活的工作表
    Set ws = ThisWorkbook.Sheets("Tabelle1")
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 根文件夹路径
    Const rootFolder As String = "D:\SF\"
    
    ' 创建根文件夹（不存在则新建）
    If Not fso.FolderExists(rootFolder) Then
        MkDir rootFolder
    End If
    
    ' 从第7行开始遍历A列，直到空行
    currentRow = 7
    Do While ws.Cells(currentRow, "A").Value <> ""
        ' 拼接当前行对应的文件夹路径
        folderPath = rootFolder & ws.Cells(currentRow, "A").Value
        
        ' 创建目标文件夹（不存在则新建）
        If Not fso.FolderExists(folderPath) Then
            MkDir folderPath
        End If
        
        ' 获取当前行的下载URL
        URL = ws.Cells(currentRow, "D").Value
        If URL = "" Then
            currentRow = currentRow + 1
            GoTo NextRow
        End If
        
        ' 从URL中提取文件名，若无法提取则用行号作为备用文件名
        fileName = fso.GetFileName(URL)
        If fileName = "" Then
            fileName = "file_" & currentRow & ".dat"
        End If
        
        ' 拼接完整的文件保存路径
        FilePath = folderPath & "\" & fileName
        
        ' 执行文件下载
        Set oWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
        On Error Resume Next ' 捕获下载过程中的异常（如无效URL、网络问题）
        oWinHttp.Open "GET", URL, False
        oWinHttp.Send
        
        If oWinHttp.Status = 200 Then
            Set oStream = CreateObject("ADODB.Stream")
            oStream.Open
            oStream.Type = 1 ' 二进制模式
            oStream.Write oWinHttp.ResponseBody
            oStream.SaveToFile FilePath, 2 ' 2=覆盖已存在的同名文件
            oStream.Close
            Set oStream = Nothing
        End If
        On Error GoTo 0 ' 恢复默认错误处理
        
        Set oWinHttp = Nothing
        
NextRow:
        currentRow = currentRow + 1
    Loop
    
    Set fso = Nothing
    Set ws = Nothing
    MsgBox "文件下载完成！"
End Sub

关键修改说明 #

• 移除ActiveCell依赖：直接通过工作表对象+行号遍历单元格，避免因用户手动操作导致的执行异常
• 补充完整文件路径：使用fso.GetFileName(URL)从URL提取文件名，拼接成合法的完整保存路径
• 增加异常处理：添加错误捕获逻辑，避免单个URL下载失败导致整个脚本终止
• 优化代码结构：拆分变量职责，逻辑更清晰，便于后续维护和修改

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