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
|
dim repSource
dim repDestination
repSource = InputBox("Saisissez le nom du répertoire source : " )
repDestination = InputBox("Saisissez le nom du répertoire destination : " )
etatSousRep = InputBox("Saisissez VIDES si vous souhaitez déplacer les sous-repertoires vides du répertoire source ou TOUS pour déplacer tous ses sous-repertoires " )
Call Deplacement(repSource, repDestination, etatSousRep)
'fonction de déplacement des sous-rep d'un repertoire vers un repertoire de destination
Sub Deplacement( ByVal nomrepsource, ByVal nomrepdestination, ByVal etatrep)
MsgBox " le rep source est " & nomrepsource, vbInformation
Set objFSO=CreateObject("Scripting.FileSystemObject")
'objFolder contient tous les fichiers et sous-rep du repertoire nomrepsource
Set objFolder=objFSO.GetFolder(nomrepsource)
Select case etatSousRep
' si l'état saisi des sous-repertoires est "VIDES"
Case "VIDES":
For Each UserFolder In objFolder.subFolders
MsgBox " UserFolder en cours vaut " & UserFolder.Name & " objFolder.subfolders en cours vaut " &
objFolder.subFolders.count
'on ne deplace que les rep vides
If UserFolder.Files.count = 0 AND Userfolder.SubFolders.count = 0 Then
MsgBox(" le nombre de fichiers du rep en cours est " & Cint(UserFolder.Files.count) & " le nombre de sous-rep du rep
en cours est " & Cint(UserFolder.Subfolders.count) )
'on déplace le repertoire en cours, pas le rep source
MsgBox(" la valeur de UserFolder.Path est " & UserFolder.Path)
objFSO.MoveFolder UserFolder.Path, nomrepdestination
End if
Next
'fin condition etatrep = "VIDES"
' si l'état des sous repertoires n'est pas VIDES => on a saisi TOUS (cad sous-rep vides et non vides)
'on deplace tous les sous rep et fichiers du rep choisi
Case "TOUS" :
MsgBox "la valeur de etatSousRep est " & etatSousRep
For Each UserFolder In objFolder.subFolders
objFSO.MoveFolder UserFolder.Path, nomrepdestination
Next
'Dans le cas où la saisie n'est ni VIDES ni TOUS, il y a erreur de saisie de l'utilisateur
' et on ne déplace que les sous-rep vides
Case Else
MsgBox "Vous avez fait une erreur de saisie, seuls les sous-repertoires vides seront déplacés ", vbCritical
'
For Each UserFolder In objFolder.subFolders
'on ne deplace que les rep vides
If UserFolder.Files.count = 0 AND Userfolder.SubFolders.count = 0 Then
'on déplace le repertoire en cours pas le rep source
objFSO.MoveFolder UserFolder.Path, nomrepdestination
End if
Next
End Select
End Sub |
