Comment télécharger des données par ftp, http ou socket à partir d'une feuille de calcul avec VBA pour Microsoft Office ?

Question

J'ai une feuille de calcul Excel, et je veux y mettre un bouton, afin que les utilisateurs puissent télécharger leurs données vers un serveur http/ftp, ou envoyer les données au serveur en utilisant directement une socket. J'ai remarqué que certaines personnes créent un ftp script pour faire. Tout d'abord, je ne suis pas sûr que tout le monde ait ftp sur sa machine Windows, et ensuite, je préférerais utiliser une méthode qui me permette de mieux surveiller la progression du téléchargement. Par exemple, je veux savoir si l'identification de l'utilisateur/mot de passe a échoué, si la transmission s'est terminée avec succès, ou s'il y a eu d'autres types d'erreurs avec le serveur de réception. Merci.

Answer 1

Je ne suis pas sûr que vous souhaitiez utiliser Microsoft Internet Transfer Control (msinet.ocx), mais c'est une option qui vous permettrait d'obtenir le contrôle que vous souhaitez. Voici un lien vers une bonne ressource pour vous aider à démarrer : http://officeone.mvps.org/vba/ftp_upload_file.html

Answer 2

J'ai écrit une classe FTP pour VBA, qui utilise les fonctions de l'API Windows pour transférer un fichier :

Option Explicit

' die wichtigsten Funktionen und Typen aus dem WinInet-API

Private Const MAX_PATH = 260
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_FLAG_ASYNC = &H10000000
Private Const INTERNET_DEFAULT_FTP_PORT = 21
Private Const INTERNET_SERVICE_FTP = 1
Private Const FTP_TRANSFER_TYPE_BINARY As Long = 2

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 * MAX_PATH
  cAlternate As String * 14
End Type

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (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 InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (ByRef lpdwError As Long, ByVal lpszBuffer As String, ByRef lpdwBufferLength As Long) As Boolean
Private Declare Function FtpPutFile Lib "WinInet" Alias "FtpPutFileA" (ByVal hFtp As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function FtpGetFile Lib "WinInet" Alias "FtpGetFileA" (ByVal hFtp 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 FtpDeleteFile Lib "WinInet" Alias "FtpDeleteFileA" (ByVal hFtp As Long, ByVal lpszKillFile As String) As Long
Private Declare Function FtpCreateDirectory Lib "WinInet" Alias "FtpCreateDirectoryA" (ByVal hFtp As Long, ByVal lpszNewDir As String) As Long
Private Declare Function FtpGetCurrentDirectory Lib "WinInet" Alias "FtpGetCurrentDirectoryA" (ByVal hFtp As Long, lpszDirectory As String, ByVal BuffLength As Long) As Long
Private Declare Function FtpSetCurrentDirectory Lib "WinInet" Alias "FtpSetCurrentDirectoryA" (ByVal hFtp As Long, ByVal lpszDirectory As String) As Long
Private Declare Function FtpRemoveDirectory Lib "WinInet" Alias "FtpRemoveDirectoryA" (ByVal hFtp As Long, ByVal lpszKillDir As String) As Long
Private Declare Function FtpFindFirstFile Lib "WinInet" Alias "FtpFindFirstFileA" (ByVal hFtp As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function FtpRenameFile Lib "WinInet" Alias "FtpRenameFileA" (ByVal hFtp As Long, ByVal lpszCurFile As String, ByVal lpszNewFile As String) As Long
Private Declare Function GetLastError Lib "kernel" () As Integer

' Member der Klasse
Private m_hConnect As Long
Private m_hFtp As Long

Private Sub Class_Initialize()
    m_hConnect = 0
    m_hFtp = 0
End Sub

Private Sub Class_Terminate()
    Disconnect
End Sub

Public Sub Connect(server As String, user As String, pwd As String)
    m_hConnect = InternetOpen("Microsoft Excel", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0) 'INTERNET_FLAG_ASYNC)

    If m_hConnect = 0 Then
        Err.Raise vbObjectError + 1, , "Verbindung konnte nicht hergestellt werden! Fehler " + CStr(GetLastError)
        Exit Sub
    End If

    m_hFtp = InternetConnect(m_hConnect, server, INTERNET_DEFAULT_FTP_PORT, user, pwd, INTERNET_SERVICE_FTP, 0, 0)

    If m_hFtp = 0 Then
        Err.Raise vbObjectError + 1, , "Verbindung konnte nicht hergestellt werden! Fehler " + CStr(GetLastError)
        Exit Sub
    End If
End Sub

Public Sub Disconnect()
    If m_hConnect <> 0 Then
        InternetCloseHandle m_hConnect
        m_hFtp = 0
        m_hConnect = 0
    End If
End Sub

Public Sub ChangeDir(RemoteDirectory As String)
    Dim ret As Long
    ret = FtpSetCurrentDirectory(m_hFtp, RemoteDirectory)
    If ret = 0 Then
        MsgBox CStr(Err.LastDllError)
        Err.Raise vbObjectError + 1, , LastError()

    End If
End Sub

Public Function CurrentDir() As String
    Dim ret As String
    ret = Space(1024)
    FtpGetCurrentDirectory m_hFtp, ret, 1023
    CurrentDir = ret
End Function

Public Sub PutFile(LocalFilename As String, RemoteFilename As String)
    If FtpPutFile(m_hFtp, LocalFilename, RemoteFilename, FTP_TRANSFER_TYPE_BINARY, 0) = 0 Then
        Err.Raise vbObjectError + 1, , LastError
    End If
End Sub

Private Function LastError() As String
    Dim ret As String
    Dim nErr As Long

    ret = Space(1024)
    InternetGetLastResponseInfo nErr, ret, 1024

    LastError = ret
End Function

Utilisez-le comme suit :

Dim ftp As New CFtp
ftp.Connect GetVar("SERVER"), GetVar("USER"), GetVar("PASS")
ftp.PutFile FILENAME, "/httpdocs/ang.html"
ftp.Disconnect