Suite de la discussion: VBS: recherche par extension et copie dans un dossier

Citation Envoyé par hackoofr Voir le message

Voila, tu peux tester cette version qui marche chez moi (Windows 7 32 bits) en utilisant Winrar en ligne de commande
J'ai ajouté cette fonction Compression(Source,Destination,Password).
Elle est très simple à utiliser
Tu as le choix de protéger ton archive par mot de passe, alors, tu l'appelle comme ça :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Call Compression(Source,Protected_Destination,Password)'L'archive est protégé par un mot de passe
Si tu préfères l'utiliser sans mot de passe, alors, tu l'appelle comme ça :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Call Compression(Source,Destination,"")'Sans Mot de passe
et le code complet te montre les deux à la fois
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
Option Explicit
Dim fso,ws,MyDoc,d,bf,dc,racine,ExtensionType,Password,Protected_Destination
Dim arrResult,sDrv,sFName,sFile,Source,Destination
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("Wscript.Shell")
MyDoc=ws.SpecialFolders("MyDocuments")'Dossier Mes Documents
Set bf = fso.GetFolder(MyDoc)
ExtensionType  = "JPG"
Source = MyDoc & "\" & ExtensionType
Destination = MyDoc & "\" & ExtensionType & ".rar" 'Nom de l'archive normale sans protection par mot de passe
Protected_Destination = MyDoc & "\" & ExtensionType & "_Protected.rar" 'Nom de l'archive protégé par mot de passe
Password = "123456" 'Changer juste cette variable pour choisir un autre mot de passe pour l'archive
Call CreateFolder(ExtensionType)
Set dc  = fso.Drives
For Each d in dc
	If d.IsReady Then
		racine = d.Driveletter & ":"
		GetResults racine,ExtensionType
	End If
Next
Call Compression(Source,Destination,"")'Sans Mot de passe
Call Compression(Source,Protected_Destination,Password)'L'archive est protégé par un mot de passe
'**********************************************************************************
Sub GetResults(drv,fname)
	On Error Resume Next
	Dim sWQL,oFile,Results
	sWQL     = "select * from cim_datafile where Drive='" & _
	drv & "' AND Extension = '" & fname & "'"
	For Each oFile In GetObject("winmgmts:").execquery(sWQL)
		sFile   = oFile.Name
		CopyFile sFile,ExtensionType
	Next
End Sub
'**********************************************************************************
Sub CreateFolder(name)
	Set fso    = CreateObject("Scripting.FileSystemObject")
	If Not FSO.FolderExists(bf & "\" & name) Then
		bf.subFolders.Add(name)
		Else : Exit Sub
	End If
End Sub
'**********************************************************************************
Function CopyFile(sFile,name)
	Dim  fso,ws,MyDoc,bf
	Set FSO = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("Wscript.Shell")
	MyDoc = ws.SpecialFolders("MyDocuments")'Dossier Mes Documents
	Set bf = fso.GetFolder(MyDoc)
	If FSO.FolderExists(bf & "\" & name) Then
		FSO.GetFile(sFile).Copy bf & "\" & name & "\" & FSO.GetFileName(sFile),True
	Else
		MsgBox "erreur du chemin",16,"erreur du chemin"
	End If
End Function
'**********************************************************************************
Function Compression(Source,Destination,Password)
	Dim oFSO,oShell,aScriptFilename,sScriptFilename
	Dim sWorkingDirectory,ProgramFiles,sWinZipLocation
	Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
	Set oShell = WScript.CreateObject("Wscript.Shell")
'--------Trouver le répertoire de travail--------
	aScriptFilename = Split(Wscript.ScriptFullName, "\")
	sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
	sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
'--------------------------------------
	ProgramFiles = oShell.ExpandEnvironmentStrings("%ProgramFiles%")
'-------S'assurer que nous pouvons trouver WinRAR.exe------
	If oFSO.FileExists(sWorkingDirectory & " " & "Winrar.EXE") Then
		sWinZipLocation = ""
	ElseIf oFSO.FileExists(ProgramFiles &"\Winrar\Winrar.EXE") Then
		sWinZipLocation = ProgramFiles &"\Winrar\"
	Else
		Compression = "Erreur: Impossible de trouver Winrar.EXE"
		MsgBox Compression,16,Compression
		Exit Function
	End If
'--------------------------------------
'La Commande A : Signifie ==> ajouter à une archive
'Le Commutateur -IBCK ==> Signifie : Lancer WinRAR en arrière-plan
	If Password = "" Then
		oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK """ & _
		Destination & """ """ & Source & """",0,True 
	Else
'Le Commutateur -P<mot_de_passe> : Pour utiliser un mot de passe
		oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK -p"&Password&" """ & _
		Destination & """ """ & Source & """",0,True 
	End If
	If oFSO.FileExists(Destination) Then
		Compression = 1
	Else
		Compression = "Erreur : Création d'archives a échoué !"
		MsgBox Compression,16,Compression
	End If
End Function
Merci ça fonctionne..

Par contre je pense que la compression sera pas vraiment nécessaire car la taille du dossier JPG ne diminue de presque rien pour un temps fou..

En final je voudrais envoyer ce dossier JPG via mail ou ftp.. (le plus mieux entre les 2 quoi )

Pour cela j'ai pensé a créer un serveur avec (typsoft ftp server) pour pouvoir recevoir les dossier JPG..

Qu'en pensez vous?