Tempo fa avendo la necessità di trasferire alcuni report  su un server ftp mi sono imbattuto in questo semplice codice VBA. L’ho personalizzato per i miei fini e credo possa essere utile nel caso dobbiate gestire l’upload ed il download da un server ftp senza molta fatica.

Public Sub FTPFile(strFTP, strUsername, strPassword, dirLocal, file, _
			dirFtp As Variant, n As Integer)
' indirizzoftp,iduser,password,directory locale, 
' nome file se =0 vengono presi tutti i file nella directory, 
' directory sull'ftp,n
'n = 1 upload
'n = 2 download
'es: FTPFile "pippofranco.altervista.org", "pippofranco", "segreta",_
' “c:\temp\box1”, "inventario.pdf", "sections/15_MagScorte", 1

Dim objShellLocal, objShellFTP, objFolderLocal, objFolderFTP
Dim objShellDown, objFolderDown
Dim strPathFTP, strPathDown, strPathLocal
strPathLocal = dirLocal
strPathFTP = "ftp://" & strUsername & ":" & strPassword & "@" &_
		 strFTP & "/" & dirFtp & "/"
Set objShellLocal = CreateObject("Shell.Application")
Set objFolderLocal = objShellLocal.NameSpace(strPathLocal)
Set objShellFTP = CreateObject("Shell.Application")
Set objFolderFTP = objShellFTP.NameSpace(strPathFTP)
Set objShellDown = CreateObject("Shell.Application")
Set objFolderDown = objShellDown.NameSpace(strPathLocal)

Dim Item As Object
If n = 1 Then 'upload
'Trasferisce da cartella locale a FTP
        If file = 0 Then
	     For Each Item In objFolderLocal.Items
               objFolderFTP.CopyHere strPathLocal & Item.Name
              'per spostare il file sostituire la riga 
		 'sopra con questa objFolderFTP.MoveHere 
		 'strPathLocal & Item.Name
           Next
       Else ‘viene trasferito solo un file
		objFolderFTP.CopyHere strPathLocal & file

       End If
Else  ‘ download

'Trasferisce da FTP a diversa cartella locale

 For Each Item In objFolderFTP.Items '
     objFolderDown.CopyHere strPathFTP & Item.Name
 Next
End If
Set Item = Nothing
Set objShellLocal = Nothing
Set objFolderLocal = Nothing
Set objShellFTP = Nothing
Set objFolderFTP = Nothing
Set objShellDown = Nothing
Set objFolderDown = Nothing

End Sub