deplacements de fichiers de dossier à dossier

Y compris Power BI, Power Query et toute autre question en lien avec Excel
E
EngueEngue
Membre impliqué
Membre impliqué
Messages : 1'493
Inscrit le : 12 décembre 2013
Version d'Excel : 2010

Message par EngueEngue » 10 février 2014, 16:32

Sub DeplacerFichiersEtape1(dosdestination as string)

Dim FSO As Object
Dim Dossier As Object
Dim Fichier As Object
Dim Nouvdos As Object

Dossier = "F:\Enregistrements_SOPHIA\"


'crée l'objet
Set FSO = CreateObject("Scripting.FileSystemObject")

'si le dossier cible n'existe pas, fin
If FSO.FolderExists(Dosdestination) = False Then Exit Sub

'défini le dossier où effectuer la recherche des fichiers et la création des dossiers
Set Dossier2 = FSO.getfolder(Dossier) 'parcour la collection de fichiers du dossier en cours
For Each Fichier In Dossier2.Files
msgbox(fichier.path)
msgbox(dosdestination & fichier.name)
Filecopy(fichier.path,dosdestination & fichier.name)
Kill Fichier.Path
Next

End Sub
donne mois les msgbox qui s'affichent
n
nanadoudou
Membre habitué
Membre habitué
Messages : 55
Inscrit le : 23 janvier 2014
Version d'Excel : 2010 FR

Message par nanadoudou » 10 février 2014, 16:43

je t'ai fait une copie ecran....ce sera plus simple....

je clique sur mon bouton......
il m'affiche la ligne "filecopy ..........." en rouge....... avec le message d'erreur que tu vois sur la copie ecran
si je clique OK, il me surligne en jaune "Sub.........."
engueengue.docx
(60.11 Kio) Téléchargé 8 fois
E
EngueEngue
Membre impliqué
Membre impliqué
Messages : 1'493
Inscrit le : 12 décembre 2013
Version d'Excel : 2010

Message par EngueEngue » 10 février 2014, 17:16

Quel con... Je mélange FSO et dos...
Ceci devrait le faire
Sub DeplacerFichiersEtape1(dosdestination as string)

Dim FSO As Object
Dim Dossier As Object
Dim Fichier As Object
Dim Nouvdos As Object

Dossier = "F:\Enregistrements_SOPHIA\"


'crée l'objet
Set FSO = CreateObject("Scripting.FileSystemObject")

'si le dossier cible n'existe pas, fin
If FSO.FolderExists(Dosdestination) = False Then Exit Sub

'défini le dossier où effectuer la recherche des fichiers et la création des dossiers
Set Dossier2 = FSO.getfolder(Dossier) 'parcour la collection de fichiers du dossier en cours
For Each Fichier In Dossier2.Files
msgbox(fichier.path)
msgbox(dosdestination & fichier.name)
Fso.copyfile(fichier.path,dosdestination & fichier.name)
Kill Fichier.Path
Next

End Sub
n
nanadoudou
Membre habitué
Membre habitué
Messages : 55
Inscrit le : 23 janvier 2014
Version d'Excel : 2010 FR

Message par nanadoudou » 10 février 2014, 17:23

je pense que tu vas devenir aussi dingue que moi ....lol
nouveau message d'erreur..... cette foit une textbox direct sur ma feuille (cf copie écran)
quand je te dis que c'est un truc de fou !!!
engue2.docx
(121.34 Kio) Téléchargé 7 fois
E
EngueEngue
Membre impliqué
Membre impliqué
Messages : 1'493
Inscrit le : 12 décembre 2013
Version d'Excel : 2010

Message par EngueEngue » 10 février 2014, 18:08

... Je ne vois pas d'où vient l'erreur.
n
nanadoudou
Membre habitué
Membre habitué
Messages : 55
Inscrit le : 23 janvier 2014
Version d'Excel : 2010 FR

Message par nanadoudou » 10 février 2014, 18:21

j'ai trouvé le code ci dessous....
peut etre puis je l'adapter?

Sub Copie_Fichiers_Répertoire_Source()
Dim Source As String, Destination As String
Dim FSO As Object
'*********Variables à renseigner**********
Source = "c:\Test\"
Destination = "C:\Test_Test\"
'*****************************************
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 & SubRep.Name & "\"
'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
E
EngueEngue
Membre impliqué
Membre impliqué
Messages : 1'493
Inscrit le : 12 décembre 2013
Version d'Excel : 2010

Message par EngueEngue » 10 février 2014, 18:50

Change ces deux lignes:
Fso.copyfile fichier, dosdestination, true
Fso.deletefile fichier, true
n
nanadoudou
Membre habitué
Membre habitué
Messages : 55
Inscrit le : 23 janvier 2014
Version d'Excel : 2010 FR

Message par nanadoudou » 10 février 2014, 18:54

bon ..... le rouge disparait.....lol....
on progresse enfin je suis pas d'un grand secours....
desormais il me surligne Dossier = "F:\Enregistrements_SOPHIA\

Sub Macro10()
'
DeplacerFichiersEtape1 "F:\services\Appels\serveur MANAGEMENT V2.2014\SUIVI CENTRE\APPELS\Classement des appels enregistrés\"

End Sub


Sub DeplacerFichiersEtape1(dosdestination As String)

Dim FSO As Object
Dim Dossier As Object
Dim Fichier As Object
Dim Nouvdos As Object

Dossier = "F:\Enregistrements_SOPHIA\"'

crée l'objet
Set FSO = CreateObject("Scripting.FileSystemObject")

'si le dossier cible n'existe pas, fin
If FSO.FolderExists(dosdestination) = False Then Exit Sub

'défini le dossier où effectuer la recherche des fichiers et la création des dossiers
Set Dossier = FSO.GetFolder(Dossier) 'parcour la collection de fichiers du dossier en cours
For Each Fichier In Dossier.Files
FSO.copyfile Fichier, dosdestination, True
FSO.deletefile Fichier, True
Next

End Sub
E
EngueEngue
Membre impliqué
Membre impliqué
Messages : 1'493
Inscrit le : 12 décembre 2013
Version d'Excel : 2010

Message par EngueEngue » 10 février 2014, 18:56

Dim dossier

Vire le as object
n
nanadoudou
Membre habitué
Membre habitué
Messages : 55
Inscrit le : 23 janvier 2014
Version d'Excel : 2010 FR

Message par nanadoudou » 10 février 2014, 19:10

ok, apres modif il bloque sur le fso
je te met une copie ecran.....
quand je te dis que je comprends pas tout..... en tout cas, chapeau pour ta patience ....!!!
et merciiiiiiiiiii
engue3.docx
(53.57 Kio) Téléchargé 7 fois
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message