如何用Excel VBA宏从FTP服务器批量下载动态命名文件

一、自动生成当前周的FTP文件夹路径 #

通过VBA的DatePart函数计算符合ISO标准的年份周数（以周一为一周起始，每年第一周至少包含4天），直接生成Week_YYYYWW格式的目标文件夹名称，无需手动修改路径。

二、批量下载指定前缀文件 #

由于URLDownloadToFile不支持通配符下载，需先通过WinInet API获取FTP目标文件夹的文件列表，筛选出前缀为1_REPORT.ABC_至5_REPORT.ABC_的文件后，逐个调用下载函数完成批量操作。

完整修改代码 #

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

Private Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
    ByVal sAgent As String, _
    ByVal lAccessType As Long, _
    ByVal sProxyName As String, _
    ByVal sProxyBypass As String, _
    ByVal lFlags As Long) As Long

Private Declare PtrSafe Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" ( _
    ByVal hInternetSession As Long, _
    ByVal sServerName As String, _
    ByVal nServerPort As Integer, _
    ByVal sUsername As String, _
    ByVal sPassword As String, _
    ByVal lService As Long, _
    ByVal lFlags As Long, _
    ByVal lContext As Long) As Long

Private Declare PtrSafe Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" ( _
    ByVal hFtpSession As Long, _
    ByVal lpszSearchFile As String, _
    lpFindFileData As WIN32_FIND_DATA, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long

Private Declare PtrSafe Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" ( _
    ByVal hFind As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" ( _
    ByVal hInet As Long) As Boolean

Private Declare PtrSafe Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" ( _
    ByVal hFtpSession As Long, _
    ByVal lpszDirectory As String) As Boolean

' 定义文件信息结构体
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As Currency
    ftLastAccessTime As Currency
    ftLastWriteTime As Currency
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * 260
    cAlternate As String * 14
End Type

' FTP连接常量
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_FLAG_PASSIVE = &H8000000

Public Sub BatchDownloadFTPFiles()
    Dim ftpServer As String, ftpUser As String, ftpPwd As String
    Dim localSavePath As String, currentWeekFolder As String
    Dim hInternet As Long, hFtpConn As Long, hFind As Long
    Dim findData As WIN32_FIND_DATA, fileName As String
    Dim fullFtpUrl As String, localFilePath As String
    Dim i As Integer
    Dim prefixes(1 To 5) As String
    
    ' --------------------------
    ' 配置参数，请根据实际修改
    ' --------------------------
    ftpServer = "ftp.abc.de"
    ftpUser = "UserName"
    ftpPwd = "Passwort"
    localSavePath = "C:/Users/xyz/Downloads/"
    prefixes(1) = "1_REPORT.ABC_"
    prefixes(2) = "2_REPORT.ABC_"
    prefixes(3) = "3_REPORT.ABC_"
    prefixes(4) = "4_REPORT.ABC_"
    prefixes(5) = "5_REPORT.ABC_"
    
    ' 生成当前周的FTP文件夹名称
    currentWeekFolder = "Week_" & Format(Date, "YYYY") & Right("00" & DatePart("ww", Date, vbMonday, vbFirstFourDays), 2)
    
    ' 初始化网络连接
    hInternet = InternetOpen("VBA FTP Client", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    If hInternet = 0 Then
        MsgBox "无法初始化网络连接", vbCritical
        Exit Sub
    End If
    
    ' 连接FTP服务器
    hFtpConn = InternetConnect(hInternet, ftpServer, 21, ftpUser, ftpPwd, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
    If hFtpConn = 0 Then
        MsgBox "无法连接FTP服务器", vbCritical
        InternetCloseHandle hInternet
        Exit Sub
    End If
    
    ' 切换到目标周文件夹
    If Not FtpSetCurrentDirectory(hFtpConn, currentWeekFolder) Then
        MsgBox "目标文件夹不存在：" & currentWeekFolder, vbCritical
        InternetCloseHandle hFtpConn
        InternetCloseHandle hInternet
        Exit Sub
    End If
    
    ' 遍历文件夹内所有文件
    hFind = FtpFindFirstFile(hFtpConn, "*.*", findData, 0, 0)
    If hFind <> 0 Then
        Do
            fileName = Left(findData.cFileName, InStr(findData.cFileName, vbNullChar) - 1)
            ' 跳过文件夹，只处理文件
            If (findData.dwFileAttributes And vbDirectory) = 0 Then
                ' 匹配目标前缀并下载
                For i = 1 To 5
                    If Left(fileName, Len(prefixes(i))) = prefixes(i) Then
                        fullFtpUrl = "ftp://" & ftpUser & ":" & ftpPwd & "@" & ftpServer & "/" & currentWeekFolder & "/" & fileName
                        localFilePath = localSavePath & fileName
                        
                        If URLDownloadToFile(0, fullFtpUrl, localFilePath, 0, 0) = 0 Then
                            Debug.Print "已下载：" & fileName
                        Else
                            Debug.Print "下载失败：" & fileName
                        End If
                        Exit For
                    End If
                Next i
            End If
        Loop While InternetFindNextFile(hFind, findData)
        InternetCloseHandle hFind
    Else
        MsgBox "目标文件夹下无文件", vbExclamation
    End If
    
    ' 关闭所有连接句柄
    InternetCloseHandle hFtpConn
    InternetCloseHandle hInternet
    MsgBox "批量下载完成", vbInformation
End Sub

代码说明 #

1. 周文件夹自动计算：通过指定周起始规则，确保生成的Week_YYYYWW格式路径与FTP服务器的文件夹命名完全匹配，无需手动更新。
2. 文件列表筛选：利用WinInet API遍历FTP文件夹，精准匹配目标前缀的文件，解决了URLDownloadToFile不支持通配符的问题。
3. 错误处理：添加了网络连接、FTP连接、文件夹存在性的检查，避免因异常导致程序崩溃，同时输出下载状态到调试窗口便于排查问题。

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