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 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
|
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Const intForReading = 1
strFTPHostName = "ftp.exemple.com"
strFTPUser = "nom-d-utilisateur"
strFTPpw = "mot-de-passe"
strRemoteDir = "repertoire-de-destination"
' Définir le dossier local qui contient les fichiers à transférer
strLocalDir = "c:\data"
strLocalDir = objFSO.GetFolder(strLocalDir).ShortPath
' Définir un fichier log qui contient les activités
strOutputFile = "c:\log.txt"
strFTPCommands = strFTPUser & vbCrLf & _
strFTPpw & vbCrLf & _
"debug" & VbCrLf & _
"prompt" & VbCrLf & _
"cd " & strRemoteDir & VbCrLf & _
"lcd " & strLocalDir & VbCrLf
strFilesToCopy = ""
For Each objFile In objFSO.GetFolder(strLocalDir).Files
If strFilesToCopy = "" Then
strFilesToCopy = "---> STOR " & objFile.Name
Else
strFilesToCopy = strFilesToCopy & ";---> STOR " & objFile.Name
End If
strFTPCommands = strFTPCommands & "mput """ & objFile.Name & """" & vbCrLf
Next
strFTPCommands = strFTPCommands & "quit"
Set objFTPFile = objFSO.CreateTextFile("FTPCommands.txt", 1)
objFTPFile.Write strFTPCommands
objFTPFile.Close
' Ajouter -d après le mot "ftp" pour activer le debug
strCommand = "cmd /c ftp -s:FTPCommands.txt " & strFTPHostName & " > " & strOutputFile
objShell.Run strCommand, 0, True
objFSO.DeleteFile "FTPCommands.txt", 1
objShell.Run "notepad " & strOutputFile, 1, False
strFilesToCopy = ";" & UCase(strFilesToCopy) & ";"
Set objOutputFile = objFSO.OpenTextFile(strOutputFile, intForReading, False)
While Not objOutputFile.AtEndOfStream
strLine = objOutputFile.ReadLine
If InStr(strFilesToCopy, ";" & UCase(strLine) & ";") > 0 Then
objOutputFile.SkipLine
strResult = objOutputFile.ReadLine
If strResult = "226 Transfert complet." Then
MsgBox "Upload réussi" & VbCrLf & "Suppression " & strLocalDir & "\" & Trim(Replace(strLine, "---> STOR ", ""))
objFSO.DeleteFile strLocalDir & "\" & Trim(Replace(strLine, "---> STOR ", "")), True
Else
MsgBox "Erreur lors de l'upload " & strLocalDir & "\" & Trim(Replace(strLine, "---> STOR ", ""))
End If
End If
Wend
objOutputFile.Close
Set objOutputFile = Nothing
Set objExec = Nothing
Set objShell = Nothing
Set objFSO = Nothing |
Partager