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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
| Dim Source, sMsg, Hostname, objNetwork, objShell, dest
Dim oFSO, contents, folderName, fileColl, Filedetails, MinuteMax
Source = "C:\xxxx\xxxx\xxxx\depart\"
dest = "C:\xxxxx\xxxxx\xxxxx\transfert\"
MinuteMax = 11
Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject ("Wscript.Network")
Set folderName = oFSO.GetFolder(Source)
Set fileColl = folderName.Files
DateSysteme = Now 'On recupère la date système
For Each contents in fileColl
If oFSO.GetExtensionName(contents) = "txt" Then
Set Filedetails = oFSO.GetFile(contents)
If DateDiff("n",Filedetails.DateCreated,DateSysteme) < MinuteMax Then
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'oFSO.CopyFile Source& contents.Name, Destination,True
''''''''''''''''''''''''''''''''''''''''
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f_cmd, f_ret
' Initialisation de données de connexions au FTP
FTP = "220.xx.xx.xx"
Login = "user"
Pass = "password"
FichierLocal = Source& contents.Name
sRemotePath = "D:\MSJ_TEST\"
FichierCommandeFTP = "Cmdftp.ftp"
FichierRetourFTP = "return.txt"
' Écriture du fichier des commandes FTP
Set f_cmd = oFSO.OpenTextFile(FichierCommandeFTP, ForWriting, True)
f_cmd.Write "OPEN " & FTP & vbCrLf
f_cmd.Write "" & Login & vbCrLf & Pass & vbCrLf
f_cmd.Write "cd " & sRemotePath & vbCrLf
f_cmd.Write "put " & FichierLocal & vbCrLf
f_cmd.Write "quit"
f_cmd.Close
' Appel a FTP.exe pour exécution du fichier de commande
' L'éxécution créera le fichier de retour
Set WSHShell = CreateObject("WScript.Shell")
WSHShell.Run "cmd /c ftp.exe -s:" & FichierCommandeFTP & " > " & FichierRetourFTP, 0 , True
oFSO.CopyFile Source& contents.Name, dest, true
' Si le fichier de retour existe
' Si inexistant => Probleme d'execution => Retour à False
UploadByFTP = False
If oFSO.FileExists(FichierRetourFTP) Then
Set f_ret = oFSO.OpenTextFile(FichierRetourFTP, ForReading)
' Parcour du fichier de retour à la recherche de l'indication "Transfert OK"
while Not f_ret.AtEndOfStream And UploadByFTP = False
' Si une des lignes commence par "226 ", alors il n'y a pas eu de probleme lors du transfert
iF Left(f_ret.ReadLine,4) = "226 " Then
UploadByFTP = True
End If
Wend
f_ret.close
Set f_ret = Nothing
' Suppression du fichier de retour
'oFSO.DeleteFile FichierRetourFTP
End If
' Suppression du fichier de commande FTP
oFSO.DeleteFile FichierCommandeFTP
Set WSHShell = Nothing
Set f_cmd = Nothing
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
end if
'Gestion de lenvoi automatique de mail
If Err.Number <> 0 Then
'ENVOI DE MAIL AUTO
end if 'Fin err
end if
Next
Set oFSO = Nothing
wscript.echo "VBS Complete"
WScript.Quit |
