bonjour....
bon j'ai un peu réflechi et modifié ce code.....
ça marche mais pas en entier...... il me copie bien les fichiers du sous repertoire source..... mais d'un seul sous sous repertoire ..... il ne boucle pas sur tous les sous sous repertoires
et il m'affiche donc ensuite en surlignage la ligne ci dessous....
Sub Copie_Fichiers_Répertoire_Source()
Dim Source As String, Destination As String
Dim FSO As Object
'*********Variables à renseigner**********
Source = "F:\Enregistrements_SOPHIA\"
Destination = "F:\services\Appels\serveur MANAGEMENT V2.2014\SUIVI CENTRE\APPELS\Classement des appels enregistrés\"
'*****************************************
If Dir(Source, vbDirectory) <> "" Then
Set FSO = CreateObject("Scripting.FileSystemObject")
Boucle_Sur_Tout_Le_Répertoire FSO, Source, Destination
Set FSO = Nothing
End If
End Sub
'----------------------------------
Sub Boucle_Sur_Tout_Le_Répertoire(FSO As Object, _
Source As String, Destination As String)
Dim SubRep As Object
Dim Rep As Object
Dim Fichier As Object
With FSO
Set Rep = .GetFolder(Source)'
Boucle sur tous les fichiers du répertoire
For Each File In Rep.Files
'Copie les fichiers vers la destination
.CopyFile File, Destination, True
'Supprime les fichiers du répertoire source
.DeleteFile File, True
Next
End With
If Not Source Like "*System Volume Information*" Then
'Boucle sur tous les sous-répertoires
For Each SubRep In Rep.SubFolders
'Modification du chemin de la destination
Destination = Destination
'Vérifier si le répertoire existe dans le répertoire
'de destination, sinon création de celui-ci
If Dir(Destination, vbDirectory) = "" Then
FSO.CreateFolder Destination
End If
'Modification du répertoire Source
Source = Source & SubRep.Name & "\"
'Appel de la procédure
Boucle_Sur_Tout_Le_Répertoire FSO, Source, Destination
Next
End If
End Sub