vba宏下载多个文件ftp

Question

我想使用 ftp 将几个文件下载到我的电脑。我在 vba 上写了一个宏，我知道如何为单个文件做，我使用这个函数：

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)
    
    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

FtpGetFileA 将要下载的文件的确切名称作为参数。如何从远程目录下载所有文件？

Answer 1

我找到了解决方案谢谢你的帮助。这是代码：

Global num_inspection
Global ligne_inspection
Global actual_wkb
Const MAX_PATH = 260

Dim fichier_actu As String
Dim set_mask As String
Dim level As String
Dim entity As String
Dim hFind As Long, lRet As Long
Private Const FTP_TRANSFER_TYPE_UNKNOWN     As Long = 0
Private Const INTERNET_FLAG_RELOAD          As Long = &H80000000

Public Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Public 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

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

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 dwContent As Long) As Long

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

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 Long, _
    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 FtpGetFileA Lib "wininet.dll" ( _
    ByVal hConnect As Long, _
    ByVal lpszRemoteFile As String, _
    ByVal lpszNewFile As String, _
    ByVal fFailIfExists As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long

Private Declare PtrSafe Function InternetCloseHandle Lib "wininet" ( _
    ByVal hInet As Long) As Long
    
Dim pData As WIN32_FIND_DATA

Sub testFTP()
HostName = "********"
UserName = "****"
Password = "****"
RemoteFileName = "file expression like *.*"
LocalFileName = "yourLocalFileName"
NA = FtpDownload(RemoteFileName, LocalFileName, HostName, 21, UserName, Password)
'Workbooks.OpenText Filename:="yourLocalFileName", _
        Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=True, Other:=True, OtherChar:=";", FieldInfo:= _
        Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1))
End Sub
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)
    
    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)
    
    Call FtpSetCurrentDirectory(hConn, "here your remote directory")
    pData.cFileName = String(MAX_PATH, 0)
    
    hFind = FtpFindFirstFile(hConn, strRemoteFile, pData, 0, 0)
    
    If FtpGetFileA(hConn, pData.cFileName, 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