Adapatation fileSystemObject

[vinz602]

Bonjour à tous le monde

je souhaites déplacer des dossiers selon les chemins "source et destination" renseigné dans une colonne de mon fichier excel

je suis sur ce script mais comment mettre la variable du chemin "source (colonne B) et destination (colonne C)" et de créer une boucle sur chaque ligne avec OK en colonne G

Qui peux m'aider à résoudre ma problématique

Sub deplacement

Dim fs As New Scripting.FileSystemObject


fs.CreateFolder "e:\data\excel"


fs.CopyFolder "c:\data\excel", "e:\data\excel"


fs.DeleteFolder "c:\data\excel"


Set fs = Nothing

end Sub

 

[Dranreb]

Bonjour.
Je ne comprends pas trop où est votre problème: Je ne connais pas de cas où ne pourrait pas spécifier une expression ou un élément de tableau là où on peut spécifier une constantes String.

 

[vinz602]

Bonjour Dranreb

c'est que je ne sais pas faire de bloucle ou de string
je vois un code qui semble convenir à mon problème mais certain adaptation je ne sais pas les faire...

Pouvez vous m'aider?

 

[Dranreb]

Comme ça par exemple :

Sub Déplacement()
   Dim FS As New Scripting.FileSystemObject, TDon(), L As Long
   TDon = Intersect(ActiveSheet.[B2:G1000000], ActiveSheet.UsedRange).Value
   On Error Resume Next
   For L = 1 To UBound(TDon, 1)
      If TDon(L, 6) = "OK" Then
         Err.Clear: FS.CopyFolder TDon(L, 1), TDon(L, 2)
         If Err = 0 Then FS.DeleteFolder TDon(L, 1)
         End If
      Next L
   End Sub

 

[vinz602]

Merci

Dès que je rentre je regarde ça et vous fait un retour merci pour votre réactivité et votre aide

 

[vinz602]

Re

j'ai modifié les colonnes vu que mon fichier à changer un peu
par contre il y a une erreur : Erreur de compilation : type défini par l'utilisateur non défini
le sub Déplacement est surligné en jaune.
Avez vous une idée de l'erreur?

par contre faut il rajouter une ligne pour créer le dossier dans la destination?
est ce que ce serait : "FS.CreateFolder TDon(L, 12)" avant le copyfolder ?

Sub Déplacement()

   Dim FS As New Scripting.FileSystemObject, TDon(), L As Long

   TDon = Intersect(ActiveSheet.[A2:L1000000], ActiveSheet.UsedRange).Value

   On Error Resume Next

   For L = 1 To UBound(TDon, 1)

      If TDon(L, 7) = "OK" Then

         Err.Clear: FS.CopyFolder TDon(L, 11), TDon(L, 12)

         If Err = 0 Then FS.DeleteFolder TDon(L, 11)

         End If

      Next L

   End Sub

 

[Dranreb]

La référence Microsoft Scripting Runtime n'est peut être plus cochée.
Je ne suis pas fondé à croire qu'il soit nécessaire de créer le dossier destinataire.
Par contre on devrait encore pouvoir simpifier en utilisant plutôt la méthode MoveFolder du FileSystemObject. Plus besoin du DeleteFolder alors.

 

[vinz602]

Danreb

désolé c'est bien la référence qui n'est pas cocher
Merci beaucoup pour ton aide

 

[vinz602]

La référence Microsoft Scripting Runtime n'est peut être plus cochée.
Je ne suis pas fondé à croire qu'il soit nécessaire de créer le dossier destinataire.
Par contre on devrait encore pouvoir simpifier en utilisant plutôt la méthode MoveFolder du FileSystemObject. Plus besoin du DeleteFolder alors.

Le movefolder il faudrait mettre le même code en remplaçant par :
....
If TDon(L, 7) = "OK" Then

Err.Clear: FS.MoveFolder TDon(L, 11), TDon(L, 12)

End If.....

Est ce ça ?

 

[Dranreb]

Oui, et supprimer le DeleteFolder derrière puisque le MoveFolder le fait déjà en principe.
De toute façon testez, et étoffez la détection d'erreur: If Err Then MsgBox Err.Description, vbExclamation