VBA Access. Módulo de clase clsFTP para VBA. Métodos FtpDownload y FtpUpload para descargar o subir ficheros.

Option Compare Database
Option Explicit

'http://analystcave.com/vba-downloading-files-from-ftp-using-vba/

'Ejemplo de uso:
'Dim oFtp as new clsFtp
'FtpDownload Fichero_Remoto_Origen, Fichero_Local_Destino, Servidor, Puerto, Usuario, Contraseña
'oFtp.FtpDownload "//Download/text_file.txt", "C:\text_file.txt", "192.168.0.100", 21, "username", "password"

'FtpUpload Fichero_Local_Origen, Fichero_Remoto_Destino, Servidor, Puerto, Usuario, Contraseña
'oFtp.FtpUpload "C:\text_file.txt", "//Download/text_file.txt", "192.168.0.100", 21, "username", "password"

Private Const FTP_TRANSFER_TYPE_UNKNOWN     As Long = 0
Private Const INTERNET_FLAG_RELOAD          As Long = &H80000000

'Windows API Function Declarations
#If Win64 = 1 Then
    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 FtpPutFileA _
       Lib "wininet.dll" _
 _
           (ByVal hFtpSession As Long, _
            ByVal lpszLocalFile As String, _
            ByVal lpszRemoteFile As String, _
            ByVal dwFlags As Long, _
            ByVal dwContext As Long) As Boolean
     
    Private Declare PtrSafe Function InternetCloseHandle Lib "wininet" ( _
        ByVal hInet As Long) As Long
#Else
    Private Declare 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 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 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 Function FtpPutFileA _
       Lib "wininet.dll" _
 _
           (ByVal hFtpSession As Long, _
            ByVal lpszLocalFile As String, _
            ByVal lpszRemoteFile As String, _
            ByVal dwFlags As Long, _
            ByVal dwContext As Long) As Boolean
     
    Private Declare Function InternetCloseHandle Lib "wininet" ( _
        ByVal hInet As Long) As Long
#End If

Public 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) As Boolean
On Error GoTo error
    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
        FtpDownload = True
        Debug.Print "Success"
    Else
        FtpDownload = False
        Debug.Print "Fail"
    End If

    'Close connections
    InternetCloseHandle hConn
    InternetCloseHandle hOpen
 
Exit Function
error:
    FtpDownload = False
    Debug.Print Err.Number & ": " & Err.Description
End Function

Public Function FtpUpload(ByVal strLocalFile As String, ByVal strRemoteFile As String, ByVal strHost As String, ByVal lngPort As Long, ByVal strUser As String, ByVal strPass As String) As Boolean
On Error GoTo error
    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 FtpPutFileA(hConn, strLocalFile, strRemoteFile, FTP_TRANSFER_TYPE_UNKNOWN Or INTERNET_FLAG_RELOAD, 0) Then
        FtpUpload = True
        Debug.Print "Success"
    Else
        FtpUpload = False
        Debug.Print "Fail"
    End If

    'Close connections
    InternetCloseHandle hConn
    InternetCloseHandle hOpen

Exit Function
error:
    FtpUpload = False
    Debug.Print Err.Number & ": " & Err.Description
End Function