如何在VBA中通过FTP使用正则匹配并下载指定格式文件？

问题背景 #

我用VBA宏通过FTP下载文件，文件名是动态变化的：格式为/tmp/SLX2088-<唯一ID>_<日期时间>.txt，其中SLX2088-是固定前缀，<唯一ID>需要通过num_id变量传入。之前尝试用通配符表达式"SLX2088-" & id & "*.txt"匹配，但本地有效、FTP环境下无效。需要实现通过唯一ID匹配目标文件并完成下载的功能，已有如下FtpDownload函数：

Function FtpDownload(ByVal strRemoteFile As String, ByVal strLocalFile As String, ByVal strHost As String, ByVal lngPort As Long, ByVal strUser As String, ByVal strPass As String)
    'usage
    'FtpDownload "/TEST/test.html", "c:\test.html", "ftp.server.com", 21, "user", "password"
    Dim hOpen   As Long
    Dim hConn   As Long

    hOpen = InternetOpenA("FTPGET", 1, vbNullString, vbNullString, 1)
    hConn = InternetConnectA(hOpen, strHost, lngPort, strUser, strPass, 1, 0, 2)

    If FtpGetFileA(hConn, strRemoteFile, strLocalFile, 1, 0, FTP_TRANSFER_TYPE_UNKNOWN Or INTERNET_FLAG_RELOAD, 0) Then
        Debug.Print "done"
        NA = MsgBox("Done", vbOKOnly + vbInformation, "FTP transfert")
    Else
        Debug.Print "fail"
        NA = MsgBox("Fail", vbOKOnly + vbCritical, "FTP transfert")
    End If

    InternetCloseHandle hConn
    InternetCloseHandle hOpen
End Function

当前调用代码：

HostName = "**.**.***.**"
UserName = "****"
Password = "****"
RemoteFileName = "/../../../tmp/SLX2088-101005_25-Mar-2017_13_24_25.txt"
LocalFileName = "C:\temp\SLX2088-101005_25-Mar-2017_13_24_25.txt"
NA = FtpDownload(RemoteFileName, LocalFileName, HostName, 21, UserName, Password)

解决方案 #

Windows API的FtpGetFileA不支持直接用通配符匹配远程文件，必须先枚举FTP目录中的文件，再通过正则表达式筛选出目标文件，最后调用下载函数。

步骤1：补充API声明和常量 #

在模块顶部添加以下内容（放在所有函数之前）：

' 必要的Windows API声明和常量
Private Declare PtrSafe Function InternetOpenA Lib "wininet.dll" ( _
    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 InternetConnectA Lib "wininet.dll" ( _
    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 FtpFindFirstFileA Lib "wininet.dll" ( _
    ByVal hFtpSession As Long, _
    ByVal lpszSearchFile As String, _
    ByVal lpFindFileData As WIN32_FIND_DATA, _
    ByVal dwFlags As Long, _
    ByVal dwContent As Long) As Long

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

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

Private Declare PtrSafe Function FtpGetFileA Lib "wininet.dll" ( _
    ByVal hFtpSession As Long, _
    ByVal lpszRemoteFile As String, _
    ByVal lpszLocalFile As String, _
    ByVal fFailIfExists As Boolean, _
    ByVal dwLocalFileAttributes As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Boolean

Private Declare PtrSafe Function FtpSetCurrentDirectoryA Lib "wininet.dll" ( _
    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

' 常量定义
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_SERVICE_FTP = 1
Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Const INTERNET_FLAG_RELOAD = &H80000000
Const ERROR_NO_MORE_FILES = 18

步骤2：新增FTP文件查找函数 #

添加一个函数，用于在指定FTP目录中根据唯一ID匹配目标文件名：

Function FindFtpFileByID(ByVal strHost As String, ByVal lngPort As Long, ByVal strUser As String, ByVal strPass As String, ByVal strRemotePath As String, ByVal num_id As String) As String
    Dim hOpen As Long, hConn As Long, hFind As Long
    Dim findData As WIN32_FIND_DATA
    Dim regex As Object
    Dim pattern As String
    Dim fileName As String
    
    ' 初始化正则表达式，匹配SLX2088-<num_id>开头的txt文件
    Set regex = CreateObject("VBScript.RegExp")
    pattern = "^SLX2088-" & num_id & "_.*\.txt$"
    regex.pattern = pattern
    regex.IgnoreCase = False
    
    ' 建立FTP连接
    hOpen = InternetOpenA("FTP_FILE_FINDER", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    If hOpen = 0 Then GoTo Cleanup
    
    hConn = InternetConnectA(hOpen, strHost, lngPort, strUser, strPass, INTERNET_SERVICE_FTP, 0, 0)
    If hConn = 0 Then GoTo Cleanup
    
    ' 切换到目标远程目录
    If FtpSetCurrentDirectoryA(hConn, strRemotePath) = False Then
        Debug.Print "无法切换到远程目录: " & strRemotePath
        GoTo Cleanup
    End If
    
    ' 枚举目录中的文件
    hFind = FtpFindFirstFileA(hConn, "*.*", findData, 0, 0)
    If hFind = 0 Then GoTo Cleanup
    
    Do
        ' 提取文件名（去掉末尾的空字符）
        fileName = Left(findData.cFileName, InStr(findData.cFileName, vbNullChar) - 1)
        
        ' 跳过目录和系统文件
        If (findData.dwFileAttributes And vbDirectory) = 0 Then
            ' 用正则匹配文件名
            If regex.Test(fileName) Then
                FindFtpFileByID = strRemotePath & "/" & fileName
                Exit Do
            End If
        End If
    Loop While InternetFindNextFileA(hFind, findData)
    
    ' 检查是否找到文件
    If FindFtpFileByID = "" Then
        Debug.Print "未找到匹配ID: " & num_id & "的文件"
    End If

Cleanup:
    ' 关闭所有句柄
    If hFind <> 0 Then InternetCloseHandle hFind
    If hConn <> 0 Then InternetCloseHandle hConn
    If hOpen <> 0 Then InternetCloseHandle hOpen
    Set regex = Nothing
End Function

步骤3：修改调用逻辑 #

更新调用代码，先查找目标文件，再执行下载：

Sub DownloadFileByID()
    Dim HostName As String
    Dim UserName As String
    Dim Password As String
    Dim RemotePath As String
    Dim num_id As String
    Dim RemoteFileName As String
    Dim LocalFileName As String
    
    ' 配置FTP参数
    HostName = "**.**.***.**"
    UserName = "****"
    Password = "****"
    RemotePath = "/tmp" ' 远程文件所在目录
    num_id = "101005" ' 需要匹配的唯一ID
    
    ' 查找目标文件
    RemoteFileName = FindFtpFileByID(HostName, 21, UserName, Password, RemotePath, num_id)
    
    If RemoteFileName <> "" Then
        ' 生成本地保存路径（可自定义）
        LocalFileName = "C:\temp\" & Mid(RemoteFileName, InStrRev(RemoteFileName, "/") + 1)
        ' 执行下载
        Call FtpDownload(RemoteFileName, LocalFileName, HostName, 21, UserName, Password)
    Else
        MsgBox "未找到对应ID的文件", vbExclamation
    End If
End Sub

关键说明 #

• FtpGetFileA不支持通配符，必须先枚举目录文件再筛选
• 使用VBScript正则表达式对象匹配文件名，确保精准匹配SLX2088-<num_id>_*.txt格式
• 查找函数会自动跳过目录，只匹配文件
• 若存在多个匹配文件，会返回第一个找到的文件（可根据需求修改为返回全部或最新文件）

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