64位Excel VBA中FtpFindFirstFile始终返回0的问题排查

在64位Windows 10系统的64位Office Excel VBA中实现FTP功能时，尝试列出FTP服务器指定目录下的单个文本文件名，但EnumFiles过程中无论使用何种通配符，FtpFindFirstFile始终返回0，导致过程直接退出。已确认InternetOpen、InternetConnect、FtpSetCurrentDirectory均执行成功，服务器IP、凭据及目录存在性均无误。

相关代码 #

常量与类型声明 #

Private Const MAX_PATH As Integer = 260
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_DEFAULT_FTP_PORT = 21
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_FLAG_PASSIVE = &H8000000
Private Const INTERNET_NO_CALLBACK = 0

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

WinInet.dll 64位PtrSafe函数声明 #

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

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

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

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

Private Declare PtrSafe Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" ( _
    ByVal hFtpSession As LongPtr, _
    ByVal lpszCurrentDirectory As String, _
    ByVal lpdwCurrentDirectory As LongPtr) As LongPtr

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

调用代码 #

Public Sub EnumFiles(ByVal hConnection As LongPtr)
    Dim pData As WIN32_FIND_DATA
    
    #If VBA7 Then
        Dim hFind As LongPtr, lRet As LongPtr
    #Else
        Dim hFind As Long, lRet As Long
    #End If

    pData.cFileName = String(MAX_PATH, vbNullChar)
    hFind = FtpFindFirstFile(hConnection, "*.*", pData, INTERNET_FLAG_RELOAD Or INTERNET_FLAG_NO_CACHE_WRITE, 0)
    If hFind = 0 Then Exit Sub

    MsgBox Left$(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)

    Do
        pData.cFileName = String(MAX_PATH, vbNullChar)
        lRet = InternetFindNextFile(hFind, pData)
        If lRet = 0 Then Exit Do
        MsgBox Left$(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
    Loop

    InternetCloseHandle hFind
End Sub

Public Sub ListFilesOnFTP()
    #If VBA7 Then
        Dim hOpen As LongPtr, hConnection As LongPtr
    #Else
        Dim hOpen As Long, hConnection As Long
    #End If
    
    Dim blReturn As Boolean
    Dim strFTPServerIP As String, strUsername As String, strPassword As String, strRemoteDirectory As String
    
    strFTPServerIP = "12.345.678.901"
    strUsername = "username"
    strPassword = "password"
    strRemoteDirectory = "directory_name/"
    
    hOpen = InternetOpen("FTP", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    hConnection = InternetConnect(hOpen, strFTPServerIP, INTERNET_DEFAULT_FTP_PORT, strUsername, strPassword, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, INTERNET_NO_CALLBACK)
    blReturn = FtpSetCurrentDirectory(hConnection, strRemoteDirectory)
    Call EnumFiles(hConnection)
    InternetCloseHandle hConnection
    InternetCloseHandle hOpen
End Sub

问题原因分析 #

1. 缺失InternetFindNextFile的64位声明：EnumFiles过程中调用了InternetFindNextFile但未添加该函数的64位PtrSafe版本，导致VBA无法正确解析调用，间接影响FtpFindFirstFile的执行结果。
2. 错误使用HTTP专属标志位：FtpFindFirstFile的dwFlags参数使用了INTERNET_FLAG_RELOAD和INTERNET_FLAG_NO_CACHE_WRITE，这两个标志针对HTTP缓存设计，不适用于FTP操作，会干扰函数正常执行。
3. 无错误诊断机制：未调用InternetGetLastResponseInfo获取FtpFindFirstFile返回0时的具体错误码与描述，无法定位权限限制、目录为空或服务器兼容性等问题。
4. 通配符兼容性问题：部分FTP服务器对*.*的解析逻辑特殊，仅匹配带扩展名的文件，若目标文件无扩展名或服务器不支持该通配符，会导致查询无结果。

解决思路与修正代码 #

1. 补充必要函数声明 #

添加InternetFindNextFile和InternetGetLastResponseInfo的64位PtrSafe声明，用于遍历文件和获取错误信息：

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

Private Declare PtrSafe Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
    ByRef lpdwError As LongPtr, _
    ByVal lpszBuffer As String, _
    ByRef lpdwBufferLength As LongPtr) As Boolean

2. 调整FtpFindFirstFile参数 #

移除HTTP相关标志，改用0作为dwFlags值，同时将通配符改为兼容性更强的*：

hFind = FtpFindFirstFile(hConnection, "*", pData, 0, 0)

3. 添加错误诊断逻辑 #

在FtpFindFirstFile返回0时，获取具体错误信息：

If hFind = 0 Then
    Dim dwErr As LongPtr, errMsg As String, bufLen As LongPtr
    bufLen = 256
    errMsg = String(bufLen, vbNullChar)
    If InternetGetLastResponseInfo(dwErr, errMsg, bufLen) Then
        MsgBox "FtpFindFirstFile调用失败:" & vbCrLf & "错误代码: " & dwErr & vbCrLf & "错误信息: " & Left(errMsg, bufLen - 1)
    Else
        MsgBox "FtpFindFirstFile调用失败，无法获取错误信息，系统错误码: " & Err.LastDllError
    End If
    Exit Sub
End If

4. 验证当前目录 #

在调用EnumFiles前，确认已成功切换到目标目录：

Dim currentDir As String, dirLen As LongPtr
currentDir = String(MAX_PATH, vbNullChar)
dirLen = MAX_PATH
If FtpGetCurrentDirectory(hConnection, currentDir, dirLen) <> 0 Then
    MsgBox "当前FTP目录: " & Left(currentDir, InStr(currentDir, vbNullChar) - 1)
Else
    MsgBox "获取当前目录失败"
End If

修正后的EnumFiles过程 #

Public Sub EnumFiles(ByVal hConnection As LongPtr)
    Dim pData As WIN32_FIND_DATA
    
    #If VBA7 Then
        Dim hFind As LongPtr, lRet As LongPtr
    #Else
        Dim hFind As Long, lRet As Long
    #End If

    pData.cFileName = String(MAX_PATH, vbNullChar)
    ' 使用兼容通配符与正确标志位
    hFind = FtpFindFirstFile(hConnection, "*", pData, 0, 0)
    
    ' 错误诊断
    If hFind = 0 Then
        Dim dwErr As LongPtr, errMsg As String, bufLen As LongPtr
        bufLen = 256
        errMsg = String(bufLen, vbNullChar)
        If InternetGetLastResponseInfo(dwErr, errMsg, bufLen) Then
            MsgBox "FtpFindFirstFile调用失败:" & vbCrLf & "错误代码: " & dwErr & vbCrLf & "错误信息: " & Left(errMsg, bufLen - 1)
        Else
            MsgBox "FtpFindFirstFile调用失败，无法获取错误信息，系统错误码: " & Err.LastDllError
        End If
        Exit Sub
    End If

    MsgBox "找到文件: " & Left$(pData.cFileName, InStr(1, pData.cFileName, vbNullChar, vbBinaryCompare) - 1)

    Do
        pData.cFileName = String(MAX_PATH, vbNullChar)
        lRet = InternetFindNextFile(hFind, pData)
        If lRet = 0 Then
            ' 区分正常结束与错误
            Dim dwEndErr As LongPtr
            dwEndErr = Err.LastDllError
            If dwEndErr <> 123 ' ERROR_NO_MORE_FILES
                MsgBox "InternetFindNextFile调用失败，错误码: " & dwEndErr
            End If
            Exit Do
        End If
        MsgBox "找到文件: " & Left$(pData.cFileName, InStr(1, pData.cFileName, vbNullChar, vbBinaryCompare) - 1)
    Loop

    InternetCloseHandle hFind
End Sub

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