修改VBA代码实现按A列值创建文件夹并下载多列URL文件

修改要点及完整代码 #

核心修改内容 #

1. 新增产品文件夹创建逻辑：处理每个产品的下载任务前，检查对应产品名称的文件夹是否存在，不存在则自动创建。
2. 优化文件后缀适配：从URL中提取原始文件后缀，兼容Tiff、JPEG、PDF等多种格式，替代原代码固定的.tiff后缀。
3. 调整文件保存路径：将文件保存到对应产品的子文件夹内，实现按产品分类存储。

修改后的完整VBA代码 #

Option Explicit

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Dim Ret As Long

'~~> 根保存目录，根据实际情况修改
Const FolderName As String = "C:\Users\XXXXX\Desktop\images\"

Sub Sample()
    Dim ws As Worksheet
    Dim LastRow As Long, i As Long
    Dim strPath As String
    Dim c As Range, n As Long
    Dim productFolder As String
    Dim fileExt As String

    '~~> 指定数据所在工作表
    Set ws = Sheets("Sheet1")

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LastRow '<~~ 从第2行开始，第1行为表头
        ' 构建当前产品的专属文件夹路径
        productFolder = FolderName & ws.Range("A" & i).Value & "\"
        
        ' 检查文件夹是否存在，不存在则创建
        If Dir(productFolder, vbDirectory) = "" Then
            MkDir productFolder
        End If

        n = 1
        Set c = ws.Range("B" & i)
        Do While Len(c.Value) > 0 ' 循环处理当前产品的所有URL
            ' 从URL中提取文件后缀，兼容多种格式
            If InStrRev(c.Value, ".") > 0 Then
                fileExt = LCase(Mid(c.Value, InStrRev(c.Value, ".") + 1))
            Else
                fileExt = "tiff" ' 无后缀时使用默认值
            End If
            
            ' 构建最终保存路径（产品文件夹内）
            strPath = productFolder & ws.Range("A" & i).Value & _
                      "_" & Right("00" & n, 2) & "." & fileExt

            Ret = URLDownloadToFile(0, c.Value, strPath, 0, 0)

            c.Interior.Color = IIf(Ret = 0, vbGreen, vbRed) ' 下载状态标记：成功绿/失败红

            Set c = c.Offset(0, 1) ' 切换到下一列的URL
            n = n + 1
        Loop

    Next i
End Sub

关键修改说明 #

• 文件夹创建逻辑：通过Dir(productFolder, vbDirectory)判断文件夹是否存在，返回空字符串表示文件夹不存在，此时调用MkDir创建对应文件夹。
• 动态后缀提取：利用InStrRev找到URL中最后一个.的位置，截取其后的字符作为文件后缀，确保下载的文件格式与原URL一致。
• 路径调整：将原代码中直接保存到根目录的路径，修改为保存到产品专属子文件夹，实现按产品分类存放需求。

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