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

Version imprimable

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:

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.

15/04/2014, 11h51
hackoofr

[VBS] Folder2FTPUpload

:salut:
Testez ce script [VBS] Folder2FTPUpload
Si vous voulez apporter des modifications à ce dernier pour vos besoins,surtout n'hésitiez pas à le demander :zoubi:
@+
15/04/2014, 14h10
positrons

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

Merci hackoofr

J'ai deja essayer ton script il me donne erreur inconnu (Windows7-64bit)
15/04/2014, 14h24
hackoofr

Citation:

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 :koi:
Avez-vous bien changer les paramètres dans le script ?
15/04/2014, 15h00
positrons

1 pièce(s) jointe(s)

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

Voir l'erreur dans l'image attachée

Pour les paramètres c'est OK
Code:

1 2 3 FTPServer = "ftp.server.com" Login = "MyLogin" Password= "MyPassword"
Merci pour l'aide

:salut:
Testez cette modification

Code:

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

Citation:

Envoyé par hackoofr

:salut:
Testez cette modification

Code:

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

15/04/2014, 19h43
positrons

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

Malheureusement même erreur

Erreur: Inconnu ?
15/04/2014, 20h00
hackoofr

Citation:

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 :koi:
le dossier distant met-le sans "/" et vérifie s'il existe dans votre espace FTP
15/04/2014, 20h08
positrons

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

Citation:

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 :koi:
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:

"/"

malheureusement même erreur

Erreur: Inconnu ?

J'ai les fichiers mais [0 octets] pour tous les fichiers
15/04/2014, 20h36
l_autodidacte

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

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

Code:

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

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

Citation:

Envoyé par hackoofr

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

Code:

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.

16/04/2014, 00h39
hackoofr

:salut:
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 :

Citation:

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

http://vb.developpez.com/telecharger/image/i/326/

Citation:

Envoyé par hackoofr

:salut:
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

http://vb.developpez.com/telecharger/image/i/326/

===================="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:

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

16/04/2014, 12h25
hackoofr

Essayez de modifier cette ligne :

Code:

Const copyType = 16

par

Code:

Const copyType = 4

Source : Folder.CopyHere method
16/04/2014, 14h08
positrons

Citation:

Envoyé par hackoofr

Essayez de modifier cette ligne :

Code:

Const copyType = 16

par

Code:

Const copyType = 4

Source : Folder.CopyHere method

Bonjour hackoofr,

négative aucun changement

Code:

Const copyType = 4
17/04/2014, 21h20
positrons

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

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.

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

Salut,

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

Code:

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]

20/04/2014, 03h19
hackoofr

Et mon +1 :plusser: Je ne le vois pas encore ? :calim2: