Bonjour,

J'ai crée le code ci-dessous pour déplacer les sous repertoires d'un repertoire source vers un repertoire de destination.

Si l'utilisateur saisit "TOUS" dans une boite de dialogue , la totalité des fichiers et sous répertoires est exportée vers un repertoire de destination.

Pour cette option, j'obtiens un message d'erreur "Le fichier existe déjà " avec ce code d'erreur 0800A003A.

Je vous remercie de bien vouloir m'aider à corriger ce qui est nécessaire pour faire fonctionner mon code .

Merci beaucoup d'avance à vous.

new_wave

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