1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
   | If UploadByFTP("C:\MonFichierLocal.txt" , "www/rep" , "FichierFTP.txt") Then
	Msgbox "Upload OK"
Else
	Msgbox "problème lors du transfert"
End If
 
Function UploadByFTP(ByVal FichierLocal, ByVal Repertoire, ByVal FichierFTP)
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim fso, f_cmd, f_ret
	
    FichierCommandeFTP = "Cmdftp.ftp"
    FichierRetourFTP = "return.txt"
   
    FTP = "ftp.site.com"
    Login = "user"
    Pass = "pass"
	
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f_cmd = fso.OpenTextFile(FichierCommandeFTP, ForWriting, True)	
    f_cmd.Write "OPEN " & FTP & vbCrLf
    f_cmd.Write "USER " & Login & vbCrLf & Pass & vbCrLf
    f_cmd.Write "cd " & Repertoire & vbCrLf
    f_cmd.Write "put " & FichierLocal & " " & FichierFTP & vbCrLf
    f_cmd.Write "quit"
    f_cmd.Close
 
	Set WSHShell = CreateObject("WScript.Shell")	
    WSHShell.Run "cmd /c ftp.exe -s:" & FichierCommandeFTP & " > " & FichierRetourFTP, 0 , True
   
    UploadByFTP = False
    Set f_ret = fso.OpenTextFile(FichierRetourFTP, ForReading)
	while Not f_ret.AtEndOfStream And UploadByFTP = False
		iF Trim(f_ret.ReadLine) = "226 File receive OK." Then
			UploadByFTP = True
		End If
    Wend
    f_ret.close
    fso.DeleteFile FichierCommandeFTP
    fso.DeleteFile FichierRetourFTP
    Set WSHShell = Nothing
    Set fso      = Nothing
    Set f_cmd    = Nothing
    Set f_ret    = Nothing
End Function | 
Partager