[vbs] Rendre invisible une fenetre FTP dans VBScript (vbs upload)

**positrons** · 15/04/2014, 10h19

Bonjour, et merci pour l'aide.

le vbs marche bien mais je suis gêné par la fenetre de chargement screenshot ici
j'aimerais la rendre invisible que rien ne s'affiche (je debute en vbs)

Le vbs:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Set oShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
 
path = "C:\test"
FTPUpload(path)
Sub FTPUpload(path)
'On Error Resume Next
 
Const copyType = 16 
waitTime = 80000
 
FTPUser = "USER"
FTPPass = "pass"
FTPHost = "Host"
FTPDir = "/Dossier"
 
strFTP = "ftp://" & FTPUser & ":" & FTPPass & "@" & FTPHost & FTPDir
Set objFTP = oShell.NameSpace(strFTP)    
 
If objFSO.FolderExists(path) Then
Set objFolder = oShell.NameSpace(path)
objFTP.CopyHere objFolder, copyType  ''<== Barre de chargement''
End If
 
WScript.Sleep waitTime
 
End Sub

ce vbs upload le contenu de mon dossier sur mon serveur FTP
Machine info: Windows 7/64bit

Merci d'avance

Franchement top ce site.

**hackoofr** · 15/04/2014, 11h51

Testez ce script [VBS] Folder2FTPUpload
Si vous voulez apporter des modifications à ce dernier pour vos besoins,surtout n'hésitiez pas à le demander

@+

**positrons** · 15/04/2014, 14h10

Merci hackoofr

J'ai deja essayer ton script il me donne erreur inconnu (Windows7-64bit)

**hackoofr** · 15/04/2014, 14h24

Envoyé par positrons

Merci hackoofr
J'ai deja essayer ton script il me donne erreur inconnu (Windows7-64bit)

à la fin d'exécution du script ou bien au début

Avez-vous bien changer les paramètres dans le script ?

**positrons** · 15/04/2014, 15h00

hackoofr

Voir l'erreur dans l'image attachée

Pour les paramètres c'est OK

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
FTPServer = "ftp.server.com"
Login = "MyLogin"
Password= "MyPassword"

Merci pour l'aide

**hackoofr** · 15/04/2014, 19h30

Testez cette modification

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
106
107
108
109
110
111
112
113
114
115
116
117
118
Dim FTPServer,Login,Password,NomDossier,CheminDossier
Copyright = "Folder2FTPUpload © Hackoo © 2012"
Set ws = CreateObject("wscript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
'**********Paramètres à modifier*************
FTPServer = "ftp.server.com"
Login = "tonlogin"
Password= "tonpass"
MondossierLocal="D:\Sauvegade"
MondossierDistant="dossierdistant"
'****************************************************
Call ContenuDossier(MondossierLocal)
Call FolderFTPUpload(FTPServer,Login,Password,MondossierLocal,MondossierDistant)
'****************************************************
Function FolderFTPUpload(sSite, sUsername,sPassword,sLocalFolder,sRemotePath) 
  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
 
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")
  Set ws = CreateObject("wscript.Shell")
  sRemotePath = Trim(sRemotePath)
  sLocalFolder = Trim(sLocalFolder)
 
  'Vérifier si le chemin, contient des espaces. 
  'si Oui,alors nous avons besoin d'ajouter des guillemets pour s'assurer qu'il passe correctement.
 
  If InStr(sRemotePath, " ") > 0 Then
    If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
      sRemotePath =  """"&sRemotePath&""""
    End If
  End If
 
  If InStr(sLocalFolder, " ") > 0 Then
    If Left(sLocalFolder, 1) <> """" And Right(sLocalFolder, 1) <> """" Then
      sLocalFolder = """"&sLocalFolder&""""
    End If
  End If
 
 sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
 
 
  Set f = oFTPScriptFSO.OpenTextFile(sFTPTemp &"\ContenuDossier.txt", ForReading, OpenAsDefault)
  LireTout = f.ReadAll
  Fichier = split(LireTout,VbcrLF)
  f.Close
  'construire un fichier de configuration pour passer les commandes ftp
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  'sFTPScript = sFTPScript & "mkdir " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "prompt n" & vbCRLF
  For i=LBound(Fichier) to UBound(Fichier)-1
  sFTPScript = sFTPScript & "put "& Fichier(i) & vbCRLF
  Next
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
 
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
 
 'Ecrire les commandes ftp à passer dans un fichier temporaire.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing
 
  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
  " > " & sFTPResults,0, TRUE
 
  'Vérifier le résultat du Transfert de l'upload
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  FailIfNotExist, OpenAsDefault)
  sResults = fFTPResults.ReadAll
  fFTPResults.Close
 
  oFTPScriptFSO.DeleteFile(sFTPTempFile)
  'oFTPScriptFSO.DeleteFile (sFTPResults)
 
  If InStr(sResults,"226") > 0 Then
    FolderFTPUpload = True
    MsgBox "Tout les fichiers contenu dans le Dossier : " &sLocalFolder& vbcr & vbcr & " ont été uploadés avec succés !"&vbcr&  LireTout,64,"Résultat du Transfert d'Upload "&Copyright
 
 
  ElseIf InStr(sResults, "File not found") > 0 Then
    FolderFTPUpload = "Error: File Not Found"
    MsgBox "Erreur : Fichier Non Trouvé ?",16,"Erreur : Fichier Non Trouvé ? "&Copyright
  ElseIf InStr(sResults, "Login authentication failed") > 0 Then
    FolderFTPUpload = "Error: Login Failed."
    MsgBox "Login authentication a echoué !",16,"Login authentication failed ! "&Copyright
  Else
    FolderFTPUpload = "Error: Unknown."
    MsgBox "Erreur: Inconnu ?",16,"Erreur: Inconnu ? "&Copyright
  End If
 
  Set oFTPScriptFSO = Nothing
  Set oFTPScriptShell = Nothing
End Function
 
 
sub ContenuDossier(sLocalFolder)
Set ws = CreateObject("wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
sFTPTemp = ws.ExpandEnvironmentStrings("%TEMP%")
if fso.FileExists(sFTPTemp &"\ContenuDossier.txt") Then
  fso.DeleteFile sFTPTemp &"\ContenuDossier.txt"
End if 
Command ="cmd /c for %I in ("&sLocalFolder&"\*.*) do (echo ""%I"") >> "& sFTPTemp &"\ContenuDossier.txt"""
Resultat = ws.run(command,0,True)
End sub
 
 
'c'est une fonction très partique qui sert à ajouter "les doubles quotes dans une variable" 
Function qq(strIn) 
    qq = Chr(34) & strIn & Chr(34)
End Function

**positrons** · 15/04/2014, 19h32

Envoyé par hackoofr

Testez cette modification

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
106
107
108
109
110
111
112
113
114
115
116
117
118
Dim FTPServer,Login,Password,NomDossier,CheminDossier
Copyright = "Folder2FTPUpload © Hackoo © 2012"
Set ws = CreateObject("wscript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
'**********Paramètres à modifier*************
FTPServer = "ftp.server.com"
Login = "tonlogin"
Password= "tonpass"
MondossierLocal="D:\Sauvegade"
MondossierDistant="dossierdistant"
'****************************************************
Call ContenuDossier(MondossierLocal)
Call FolderFTPUpload(FTPServer,Login,Password,MondossierLocal,MondossierDistant)
'****************************************************
Function FolderFTPUpload(sSite, sUsername,sPassword,sLocalFolder,sRemotePath) 
  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
 
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")
  Set ws = CreateObject("wscript.Shell")
  sRemotePath = Trim(sRemotePath)
  sLocalFolder = Trim(sLocalFolder)
 
  'Vérifier si le chemin, contient des espaces. 
  'si Oui,alors nous avons besoin d'ajouter des guillemets pour s'assurer qu'il passe correctement.
 
  If InStr(sRemotePath, " ") > 0 Then
    If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
      sRemotePath =  """"&sRemotePath&""""
    End If
  End If
 
  If InStr(sLocalFolder, " ") > 0 Then
    If Left(sLocalFolder, 1) <> """" And Right(sLocalFolder, 1) <> """" Then
      sLocalFolder = """"&sLocalFolder&""""
    End If
  End If
 
 sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
 
 
  Set f = oFTPScriptFSO.OpenTextFile(sFTPTemp &"\ContenuDossier.txt", ForReading, OpenAsDefault)
  LireTout = f.ReadAll
  Fichier = split(LireTout,VbcrLF)
  f.Close
  'construire un fichier de configuration pour passer les commandes ftp
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  'sFTPScript = sFTPScript & "mkdir " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "prompt n" & vbCRLF
  For i=LBound(Fichier) to UBound(Fichier)-1
  sFTPScript = sFTPScript & "put "& Fichier(i) & vbCRLF
  Next
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
 
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
 
 'Ecrire les commandes ftp à passer dans un fichier temporaire.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing
 
  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
  " > " & sFTPResults,0, TRUE
 
  'Vérifier le résultat du Transfert de l'upload
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  FailIfNotExist, OpenAsDefault)
  sResults = fFTPResults.ReadAll
  fFTPResults.Close
 
  oFTPScriptFSO.DeleteFile(sFTPTempFile)
  'oFTPScriptFSO.DeleteFile (sFTPResults)
 
  If InStr(sResults,"226") > 0 Then
    FolderFTPUpload = True
    MsgBox "Tout les fichiers contenu dans le Dossier : " &sLocalFolder& vbcr & vbcr & " ont été uploadés avec succés !"&vbcr&  LireTout,64,"Résultat du Transfert d'Upload "&Copyright
 
 
  ElseIf InStr(sResults, "File not found") > 0 Then
    FolderFTPUpload = "Error: File Not Found"
    MsgBox "Erreur : Fichier Non Trouvé ?",16,"Erreur : Fichier Non Trouvé ? "&Copyright
  ElseIf InStr(sResults, "Login authentication failed") > 0 Then
    FolderFTPUpload = "Error: Login Failed."
    MsgBox "Login authentication a echoué !",16,"Login authentication failed ! "&Copyright
  Else
    FolderFTPUpload = "Error: Unknown."
    MsgBox "Erreur: Inconnu ?",16,"Erreur: Inconnu ? "&Copyright
  End If
 
  Set oFTPScriptFSO = Nothing
  Set oFTPScriptShell = Nothing
End Function
 
 
sub ContenuDossier(sLocalFolder)
Set ws = CreateObject("wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
sFTPTemp = ws.ExpandEnvironmentStrings("%TEMP%")
if fso.FileExists(sFTPTemp &"\ContenuDossier.txt") Then
  fso.DeleteFile sFTPTemp &"\ContenuDossier.txt"
End if 
Command ="cmd /c for %I in ("&sLocalFolder&"\*.*) do (echo ""%I"") >> "& sFTPTemp &"\ContenuDossier.txt"""
Resultat = ws.run(command,0,True)
End sub
 
 
'c'est une fonction très partique qui sert à ajouter "les doubles quotes dans une variable" 
Function qq(strIn) 
    qq = Chr(34) & strIn & Chr(34)
End Function

ok merci je le test de suite

**positrons** · 15/04/2014, 19h43

Malheureusement même erreur

Erreur: Inconnu ?

**hackoofr** · 15/04/2014, 20h00

Envoyé par positrons

Malheureusement même erreur
Erreur: Inconnu ?

Vérifier si les fichiers ne sont pas uploader à la racine de votre serveur FTP
sinon c'est quoi le nom de serveur FTP pour faire un test et voir d’où elle vient cette erreur

le dossier distant met-le sans "/" et vérifie s'il existe dans votre espace FTP

**positrons** · 15/04/2014, 20h08

Envoyé par hackoofr

Vérifier si les fichiers ne sont pas uploader à la racine de votre serveur FTP
sinon c'est quoi le nom de serveur FTP pour faire un test et voir d’où elle vient cette erreur

le dossier distant met-le sans "/" et vérifie s'il existe dans votre espace FTP

ok je test et merci c'est sympa

Nom Serveur FTP 31.170.163.204

Test: son

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"/"

malheureusement même erreur

Erreur: Inconnu ?

J'ai les fichiers mais [0 octets] pour tous les fichiers

**l_autodidacte** · 15/04/2014, 20h36

Il faut peut-être revoir la ligne FTPServer = "ftp.server.com"

**hackoofr** · 15/04/2014, 20h46

Testez cette modification qui va ouvrir un fichier résultat à la fin du script.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
Dim FTPServer,Login,Password,NomDossier,CheminDossier
Copyright = "Folder2FTPUpload © Hackoo © 2012"
Set ws = CreateObject("wscript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
'**********Paramètres à modifier*************
FTPServer = "31.170.163.204"
Login = "tonlogin"
Password= "tonpass"
MondossierLocal="e:\Test"
MondossierDistant="dossierdistant"
'****************************************************
Call ContenuDossier(MondossierLocal)
Call FolderFTPUpload(FTPServer,Login,Password,MondossierLocal,MondossierDistant)
'****************************************************
Function FolderFTPUpload(sSite, sUsername,sPassword,sLocalFolder,sRemotePath) 
  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
 
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")
  Set ws = CreateObject("wscript.Shell")
  sRemotePath = Trim(sRemotePath)
  sLocalFolder = Trim(sLocalFolder)
 
  'Vérifier si le chemin, contient des espaces. 
  'si Oui,alors nous avons besoin d'ajouter des guillemets pour s'assurer qu'il passe correctement.
 
  If InStr(sRemotePath, " ") > 0 Then
    If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
      sRemotePath =  """"&sRemotePath&""""
    End If
  End If
 
  If InStr(sLocalFolder, " ") > 0 Then
    If Left(sLocalFolder, 1) <> """" And Right(sLocalFolder, 1) <> """" Then
      sLocalFolder = """"&sLocalFolder&""""
    End If
  End If
 
 sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
 
 
  Set f = oFTPScriptFSO.OpenTextFile(sFTPTemp &"\ContenuDossier.txt", ForReading, OpenAsDefault)
  LireTout = f.ReadAll
  Fichier = split(LireTout,VbcrLF)
  f.Close
  'construire un fichier de configuration pour passer les commandes ftp
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  'sFTPScript = sFTPScript & "mkdir " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "prompt n" & vbCRLF
  For i=LBound(Fichier) to UBound(Fichier)-1
  sFTPScript = sFTPScript & "put "& Fichier(i) & vbCRLF
  Next
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
 
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
 
 'Ecrire les commandes ftp à passer dans un fichier temporaire.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing
 
  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
  " > " & sFTPResults,0, TRUE
 
  'Vérifier le résultat du Transfert de l'upload
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  FailIfNotExist, OpenAsDefault)
  sResults = fFTPResults.ReadAll
  fFTPResults.Close
 
  oFTPScriptFSO.DeleteFile(sFTPTempFile)
  'oFTPScriptFSO.DeleteFile(sFTPResults)
  ws.run "Notepad " & sFTPResults
 
  'If InStr(sResults,"226") > 0 Then
    'FolderFTPUpload = True
    'MsgBox "Tout les fichiers contenu dans le Dossier : " &sLocalFolder& vbcr & vbcr & " ont été uploadés avec succés !"&vbcr&  LireTout,64,"Résultat du Transfert d'Upload "&Copyright
 
 
  'ElseIf InStr(sResults, "File not found") > 0 Then
    'FolderFTPUpload = "Error: File Not Found"
    'MsgBox "Erreur : Fichier Non Trouvé ?",16,"Erreur : Fichier Non Trouvé ? "&Copyright
  'ElseIf InStr(sResults, "Login authentication failed") > 0 Then
    'FolderFTPUpload = "Error: Login Failed."
    'MsgBox "Login authentication a echoué !",16,"Login authentication failed ! "&Copyright
  'Else
    'FolderFTPUpload = "Error: Unknown."
    'MsgBox "Erreur: Inconnu ?",16,"Erreur: Inconnu ? "&Copyright
  'End If
 
  Set oFTPScriptFSO = Nothing
  Set oFTPScriptShell = Nothing
End Function
 
 
sub ContenuDossier(sLocalFolder)
Set ws = CreateObject("wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
sFTPTemp = ws.ExpandEnvironmentStrings("%TEMP%")
if fso.FileExists(sFTPTemp &"\ContenuDossier.txt") Then
  fso.DeleteFile sFTPTemp &"\ContenuDossier.txt"
End if 
Command ="cmd /c for %I in ("&sLocalFolder&"\*.*) do (echo ""%I"") >> "& sFTPTemp &"\ContenuDossier.txt"""
Resultat = ws.run(command,0,True)
End sub
 
 
'c'est une fonction très partique qui sert à ajouter "les doubles quotes dans une variable" 
Function qq(strIn) 
    qq = Chr(34) & strIn & Chr(34)
End Function

**positrons** · 15/04/2014, 20h51

Envoyé par hackoofr

Testez cette modification qui va ouvrir un fichier résultat à la fin du script.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
Dim FTPServer,Login,Password,NomDossier,CheminDossier
Copyright = "Folder2FTPUpload © Hackoo © 2012"
Set ws = CreateObject("wscript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
'**********Paramètres à modifier*************
FTPServer = "31.170.163.204"
Login = "tonlogin"
Password= "tonpass"
MondossierLocal="e:\Test"
MondossierDistant="dossierdistant"
'****************************************************
Call ContenuDossier(MondossierLocal)
Call FolderFTPUpload(FTPServer,Login,Password,MondossierLocal,MondossierDistant)
'****************************************************
Function FolderFTPUpload(sSite, sUsername,sPassword,sLocalFolder,sRemotePath) 
  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
 
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")
  Set ws = CreateObject("wscript.Shell")
  sRemotePath = Trim(sRemotePath)
  sLocalFolder = Trim(sLocalFolder)
 
  'Vérifier si le chemin, contient des espaces. 
  'si Oui,alors nous avons besoin d'ajouter des guillemets pour s'assurer qu'il passe correctement.
 
  If InStr(sRemotePath, " ") > 0 Then
    If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
      sRemotePath =  """"&sRemotePath&""""
    End If
  End If
 
  If InStr(sLocalFolder, " ") > 0 Then
    If Left(sLocalFolder, 1) <> """" And Right(sLocalFolder, 1) <> """" Then
      sLocalFolder = """"&sLocalFolder&""""
    End If
  End If
 
 sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
 
 
  Set f = oFTPScriptFSO.OpenTextFile(sFTPTemp &"\ContenuDossier.txt", ForReading, OpenAsDefault)
  LireTout = f.ReadAll
  Fichier = split(LireTout,VbcrLF)
  f.Close
  'construire un fichier de configuration pour passer les commandes ftp
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  'sFTPScript = sFTPScript & "mkdir " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "prompt n" & vbCRLF
  For i=LBound(Fichier) to UBound(Fichier)-1
  sFTPScript = sFTPScript & "put "& Fichier(i) & vbCRLF
  Next
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
 
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
 
 'Ecrire les commandes ftp à passer dans un fichier temporaire.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing
 
  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
  " > " & sFTPResults,0, TRUE
 
  'Vérifier le résultat du Transfert de l'upload
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  FailIfNotExist, OpenAsDefault)
  sResults = fFTPResults.ReadAll
  fFTPResults.Close
 
  oFTPScriptFSO.DeleteFile(sFTPTempFile)
  'oFTPScriptFSO.DeleteFile(sFTPResults)
  ws.run "Notepad " & sFTPResults
 
  'If InStr(sResults,"226") > 0 Then
    'FolderFTPUpload = True
    'MsgBox "Tout les fichiers contenu dans le Dossier : " &sLocalFolder& vbcr & vbcr & " ont été uploadés avec succés !"&vbcr&  LireTout,64,"Résultat du Transfert d'Upload "&Copyright
 
 
  'ElseIf InStr(sResults, "File not found") > 0 Then
    'FolderFTPUpload = "Error: File Not Found"
    'MsgBox "Erreur : Fichier Non Trouvé ?",16,"Erreur : Fichier Non Trouvé ? "&Copyright
  'ElseIf InStr(sResults, "Login authentication failed") > 0 Then
    'FolderFTPUpload = "Error: Login Failed."
    'MsgBox "Login authentication a echoué !",16,"Login authentication failed ! "&Copyright
  'Else
    'FolderFTPUpload = "Error: Unknown."
    'MsgBox "Erreur: Inconnu ?",16,"Erreur: Inconnu ? "&Copyright
  'End If
 
  Set oFTPScriptFSO = Nothing
  Set oFTPScriptShell = Nothing
End Function
 
 
sub ContenuDossier(sLocalFolder)
Set ws = CreateObject("wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
sFTPTemp = ws.ExpandEnvironmentStrings("%TEMP%")
if fso.FileExists(sFTPTemp &"\ContenuDossier.txt") Then
  fso.DeleteFile sFTPTemp &"\ContenuDossier.txt"
End if 
Command ="cmd /c for %I in ("&sLocalFolder&"\*.*) do (echo ""%I"") >> "& sFTPTemp &"\ContenuDossier.txt"""
Resultat = ws.run(command,0,True)
End sub
 
 
'c'est une fonction très partique qui sert à ajouter "les doubles quotes dans une variable" 
Function qq(strIn) 
    qq = Chr(34) & strIn & Chr(34)
End Function

ok je test [tahia tounes]

Résultats:
Connecté à 31.170.163.204.
220---------- Welcome to Pure-FTPd [privsep] [TLS] ----------
220-You are user number 36 of 500 allowed.
220-Local time is now 15:00. Server port: 21.
220-This is a private system - No anonymous login
220 You will be disconnected after 3 minutes of inactivity.
ftp> USER u553570758
331 User u553570758 OK. Password required

230 OK. Current directory is /public_html
ftp> Dossier distant cd
binary
550 Can't change directory to binary: No such file or directory

ftp> Mode interactif désactivé.
ftp> prompt n
put "C:\Sauvegade\dossiertxt - Copie - Copie - Copie.txt"
500 I won't open a connection to 44.105.20.7 (only to 162.210.196.164)

425 No data connection
ftp> put "C:\Sauvegade\dossiertxt - Copie - Copie.txt"
425 No data connection
ftp> put "C:\Sauvegade\dossiertxt - Copie.txt"
425 No data connection
ftp> put "C:\Sauvegade\dossiertxt.txt"
425 No data connection
ftp> quit
221-Goodbye. You uploaded 0 and downloaded 0 kbytes.
221 Logout.

**hackoofr** · 16/04/2014, 00h39

D'après ce résultat de l'envoi par FTP : Je vous demande voulez-vous uploader un fichier ou bien un dossier qui contient plusieurs fichiers ?
Le serveur ne veut pas accepter les connexions de votre part d'après :

I won't open a connection to 44.105.20.7 (only to 162.210.196.164)

Testez alors, avec un autre serveur FTP
Avez-vous tester cette version avec une interface en HTA pour uploader seulement un fichier par connexion

**positrons** · 16/04/2014, 10h39

Envoyé par hackoofr

D'après ce résultat de l'envoi par FTP : Je vous demande voulez-vous uploader un fichier ou bien un dossier qui contient plusieurs fichiers ?
Le serveur ne veut pas accepter les connexions de votre part d'après :

Testez alors, avec un autre serveur FTP
Avez-vous tester cette version avec une interface en HTA pour uploader seulement un fichier par connexion

===================="Résulta:"=====================

Connecté à 31.170.163.204.
220---------- Welcome to Pure-FTPd [privsep] [TLS] ----------
220-You are user number 29 of 500 allowed.
220-Local time is now 04:30. Server port: 21.
220-This is a private system - No anonymous login
220 You will be disconnected after 3 minutes of inactivity.
ftp> USER u553570758
331 User u553570758 OK. Password required

230 OK. Current directory is /public_html
ftp> cd /
250 OK. Current directory is /
ftp> binary
200 TYPE is now 8-bit binary
ftp> Mode interactif activé.
ftp> prompt n
put "C:\Users\Windows7-32 test\Desktop\TestFTP.txt"
500 I won't open a connection to 44.105.22.27 (only to 162.210.196.162)

425 No data connection
ftp> quit
221-Goodbye. You uploaded 0 and downloaded 0 kbytes.
221 Logout.
================================================

Ce script marche bien mai c'est juste la fenêtre qui me gêne, et il possible de la rendre invisible ?

Le script :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Set oShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
 
path = "C:\test"
FTPUpload(path)
Sub FTPUpload(path)
'On Error Resume Next
 
Const copyType = 16 
waitTime = 80000
 
FTPUser = "USER"
FTPPass = "pass"
FTPHost = "Host"
FTPDir = "/Dossier"
 
strFTP = "ftp://" & FTPUser & ":" & FTPPass & "@" & FTPHost & FTPDir
Set objFTP = oShell.NameSpace(strFTP)    
 
If objFSO.FolderExists(path) Then
Set objFolder = oShell.NameSpace(path)
objFTP.CopyHere objFolder, copyType  ''<== Barre de chargement''
End If
 
WScript.Sleep waitTime
 
End Sub

Merci

**hackoofr** · 16/04/2014, 12h25

Essayez de modifier cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Const copyType = 16

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Const copyType = 4

Source : Folder.CopyHere method

**positrons** · 16/04/2014, 14h08

Envoyé par hackoofr

Essayez de modifier cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Const copyType = 16

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Const copyType = 4

Source : Folder.CopyHere method

Bonjour hackoofr,

négative aucun changement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Const copyType = 4

**positrons** · 17/04/2014, 21h20

Bonjour a tous,

Sa fait plusieur jour que je cherche en vain, je remerci tous les participon a cette discussion.

je jette l'éponge, Merci encore une foi.

**positrons** · 20/04/2014, 03h14

Salut,

Finalement c'était le transfert multiple sur mon serveur qui été désactiver et ton script marche a merveille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
 
Dim FTPServer,Login,Password,NomDossier,CheminDossier
Copyright = "Folder2FTPUpload © Hackoo © 2012"
Set ws = CreateObject("wscript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
'**********Paramètres à modifier*************
FTPServer = "31.170.163.204"
Login = "tonlogin"
Password= "tonpass"
MondossierLocal="e:\Test"
MondossierDistant="dossierdistant"
'****************************************************
Call ContenuDossier(MondossierLocal)
Call FolderFTPUpload(FTPServer,Login,Password,MondossierLocal,MondossierDistant)
'****************************************************
Function FolderFTPUpload(sSite, sUsername,sPassword,sLocalFolder,sRemotePath) 
  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
 
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")
  Set ws = CreateObject("wscript.Shell")
  sRemotePath = Trim(sRemotePath)
  sLocalFolder = Trim(sLocalFolder)
 
  'Vérifier si le chemin, contient des espaces. 
  'si Oui,alors nous avons besoin d'ajouter des guillemets pour s'assurer qu'il passe correctement.
 
  If InStr(sRemotePath, " ") > 0 Then
    If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
      sRemotePath =  """"&sRemotePath&""""
    End If
  End If
 
  If InStr(sLocalFolder, " ") > 0 Then
    If Left(sLocalFolder, 1) <> """" And Right(sLocalFolder, 1) <> """" Then
      sLocalFolder = """"&sLocalFolder&""""
    End If
  End If
 
 sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
 
 
  Set f = oFTPScriptFSO.OpenTextFile(sFTPTemp &"\ContenuDossier.txt", ForReading, OpenAsDefault)
  LireTout = f.ReadAll
  Fichier = split(LireTout,VbcrLF)
  f.Close
  'construire un fichier de configuration pour passer les commandes ftp
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  'sFTPScript = sFTPScript & "mkdir " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "prompt n" & vbCRLF
  For i=LBound(Fichier) to UBound(Fichier)-1
  sFTPScript = sFTPScript & "put "& Fichier(i) & vbCRLF
  Next
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
 
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
 
 'Ecrire les commandes ftp à passer dans un fichier temporaire.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing
 
  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
  " > " & sFTPResults,0, TRUE
 
  'Vérifier le résultat du Transfert de l'upload
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  FailIfNotExist, OpenAsDefault)
  sResults = fFTPResults.ReadAll
  fFTPResults.Close
 
  oFTPScriptFSO.DeleteFile(sFTPTempFile)
  'oFTPScriptFSO.DeleteFile(sFTPResults)
  ws.run "Notepad " & sFTPResults
 
  'If InStr(sResults,"226") > 0 Then
    'FolderFTPUpload = True
    'MsgBox "Tout les fichiers contenu dans le Dossier : " &sLocalFolder& vbcr & vbcr & " ont été uploadés avec succés !"&vbcr&  LireTout,64,"Résultat du Transfert d'Upload "&Copyright
 
 
  'ElseIf InStr(sResults, "File not found") > 0 Then
    'FolderFTPUpload = "Error: File Not Found"
    'MsgBox "Erreur : Fichier Non Trouvé ?",16,"Erreur : Fichier Non Trouvé ? "&Copyright
  'ElseIf InStr(sResults, "Login authentication failed") > 0 Then
    'FolderFTPUpload = "Error: Login Failed."
    'MsgBox "Login authentication a echoué !",16,"Login authentication failed ! "&Copyright
  'Else
    'FolderFTPUpload = "Error: Unknown."
    'MsgBox "Erreur: Inconnu ?",16,"Erreur: Inconnu ? "&Copyright
  'End If
 
  Set oFTPScriptFSO = Nothing
  Set oFTPScriptShell = Nothing
End Function
 
 
sub ContenuDossier(sLocalFolder)
Set ws = CreateObject("wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
sFTPTemp = ws.ExpandEnvironmentStrings("%TEMP%")
if fso.FileExists(sFTPTemp &"\ContenuDossier.txt") Then
  fso.DeleteFile sFTPTemp &"\ContenuDossier.txt"
End if 
Command ="cmd /c for %I in ("&sLocalFolder&"\*.*) do (echo ""%I"") >> "& sFTPTemp &"\ContenuDossier.txt"""
Resultat = ws.run(command,0,True)
End sub
 
 
'c'est une fonction très partique qui sert à ajouter "les doubles quotes dans une variable" 
Function qq(strIn) 
    qq = Chr(34) & strIn & Chr(34)
End Function

Merci encore une foi [vive la Tunisie]

**hackoofr** · 20/04/2014, 03h19

Et mon +1

Je ne le vois pas encore ?

[vbs] Rendre invisible une fenetre FTP dans VBScript (vbs upload)

VBScript

Discussions similaires

Partager

Partager