Copie de fichiers

Le
Infogroup
Bonjour à tous,

J'ai un répertoire "Rep" qui comporte des sous-répertoires avec une
arborescence à 4 ou 5 niveau, cela donne par ex.

Rep
Rep1
Rep11
Rep2
Rep21
Rep22
Rep23
Etc.

Tous ces répertoires et sous-répertoires comportent différents fichiers.
Je voudrais, via une macro, pour éviter de faire cela manuellement, copier
la totalité des fichiers dans un seul répertoire de destination
Rep_destination par ex.

Merci par avance pour votre aide

Cordialement

Infogroup
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Philippe.R
Le #18479611
Bonjour,
Regarde ceci :
http://frederic.sigonneau.free.fr/code/Fichiers/CopieTousLesFichiers.txt
ou plus largement :
http://frederic.sigonneau.free.fr/Fichiers.htm
--
Avec plaisir
http://dj.joss.free.fr/trombine.htm
http://jacxl.free.fr/mpfe/trombino.html
Philippe.R
Pour se connecter au forum :
http://www.excelabo.net/mpfe/connexion.php
News://news.microsoft.com/microsoft.public.fr.excel
"Infogroup" news:eq%23pv%
Bonjour à tous,

J'ai un répertoire "Rep" qui comporte des sous-répertoires avec une
arborescence à 4 ou 5 niveau, cela donne par ex.

Rep
Rep1
Rep11
Rep2
Rep21
Rep22
Rep23
Etc.

Tous ces répertoires et sous-répertoires comportent différents fichiers.
Je voudrais, via une macro, pour éviter de faire cela manuellement, copier
la totalité des fichiers dans un seul répertoire de destination
Rep_destination par ex.

Merci par avance pour votre aide

Cordialement

Infogroup


michdenis
Le #18479691
Tu copies tout ce qui suit dans un module standard.
La déclaration des API -> dans le haut du module.

Tu exécutes la procédure Test.

Inspiration d'une procédure d'un certain chef à 4 plumes !
;-))

'-----------------------------------------
Option Compare Text

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type

Private Declare Function FindFirstFileA Lib "Kernel32" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFileA Lib "Kernel32" _
(ByVal hFindfile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "Kernel32" _
(ByVal hFindfile As Long) As Long

Dim FileFindData As WIN32_FIND_DATA
Dim Fichier As String
Dim Dest As String

'-----------------------------------------------
Sub test()
'Ne pas oublier le "" à la fin des chemins.
'Répertoire où seront copiés les fichiers
'Le chemin et le répertoire "Dest" doit exister
Dest = "C:UsersPowerUserDest"

'Le chemin du répertoire et de ses
'sous-répertoires à scanner
Rep = "C:UsersPowerUserGrosVide"

Créer_Répertoire_Dest Dest
Application.Wait (Now + TimeValue("0:00:01"))
Recurse Rep
End Sub
'-----------------------------------------------
Private Sub Recurse(ByVal Chemin As String)
Dim hFindfile As Long
hFindfile = FindFirstFileA(Chemin & "*.*", FileFindData)
If Chemin <> "D:" Then
FindNextFileA hFindfile, FileFindData
If FindNextFileA(hFindfile, FileFindData) = 0 Then
FindClose hFindfile
Exit Sub
End If
End If
Do
Fichier = Chemin & Left$(FileFindData.cFileName, _
InStr(1, FileFindData.cFileName, vbNullChar) - 1)
If GetAttr(Fichier) And vbDirectory Then
Recurse Fichier & ""
Else
FileCopy Fichier, Dest _
& Split(Fichier, "")(UBound(Split(Fichier, "")))
End If
Loop While FindNextFileA(hFindfile, FileFindData)
FindClose hFindfile
End Sub
'-----------------------------------------------
Sub Créer_Répertoire_Dest(Chemin As String)
Dim Commande As String, Lecteur As String
Lecteur = Left(Chemin, 1)
ChDrive Lecteur
Commande = Environ("comspec") & " /c mkdir " & Chemin
Shell Commande, vbHide
End Sub
'---------------------------------------------------







"Infogroup" eq#pv#
Bonjour à tous,

J'ai un répertoire "Rep" qui comporte des sous-répertoires avec une
arborescence à 4 ou 5 niveau, cela donne par ex.

Rep
Rep1
Rep11
Rep2
Rep21
Rep22
Rep23
Etc.

Tous ces répertoires et sous-répertoires comportent différents fichiers.
Je voudrais, via une macro, pour éviter de faire cela manuellement, copier
la totalité des fichiers dans un seul répertoire de destination
Rep_destination par ex.

Merci par avance pour votre aide

Cordialement

Infogroup
Infogroup
Le #18479671
Merci Philippe, je vais essayer de me débrouiller avec tous les exemples de
frederic s.

Cordialement

Infogroup



"Philippe.R" news:
Bonjour,
Regarde ceci :
http://frederic.sigonneau.free.fr/code/Fichiers/CopieTousLesFichiers.txt
ou plus largement :
http://frederic.sigonneau.free.fr/Fichiers.htm
--
Avec plaisir
http://dj.joss.free.fr/trombine.htm
http://jacxl.free.fr/mpfe/trombino.html
Philippe.R
Pour se connecter au forum :
http://www.excelabo.net/mpfe/connexion.php
News://news.microsoft.com/microsoft.public.fr.excel
"Infogroup" news:eq%23pv%
Bonjour à tous,

J'ai un répertoire "Rep" qui comporte des sous-répertoires avec une
arborescence à 4 ou 5 niveau, cela donne par ex.

Rep
Rep1
Rep11
Rep2
Rep21
Rep22
Rep23
Etc.

Tous ces répertoires et sous-répertoires comportent différents fichiers.
Je voudrais, via une macro, pour éviter de faire cela manuellement,
copier la totalité des fichiers dans un seul répertoire de destination
Rep_destination par ex.

Merci par avance pour votre aide

Cordialement

Infogroup





Infogroup
Le #18479981
Merci mille fois michdenis, et bravo pour le chef à 4 plumes.

C'est exactement le fonctionnement que j'attendais.

Merci encore

Cordialement

Infogroup


"michdenis" news:
Tu copies tout ce qui suit dans un module standard.
La déclaration des API -> dans le haut du module.

Tu exécutes la procédure Test.

Inspiration d'une procédure d'un certain chef à 4 plumes !
;-))

'-----------------------------------------
Option Compare Text

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type

Private Declare Function FindFirstFileA Lib "Kernel32" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFileA Lib "Kernel32" _
(ByVal hFindfile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "Kernel32" _
(ByVal hFindfile As Long) As Long

Dim FileFindData As WIN32_FIND_DATA
Dim Fichier As String
Dim Dest As String

'-----------------------------------------------
Sub test()
'Ne pas oublier le "" à la fin des chemins.
'Répertoire où seront copiés les fichiers
'Le chemin et le répertoire "Dest" doit exister
Dest = "C:UsersPowerUserDest"

'Le chemin du répertoire et de ses
'sous-répertoires à scanner
Rep = "C:UsersPowerUserGrosVide"

Créer_Répertoire_Dest Dest
Application.Wait (Now + TimeValue("0:00:01"))
Recurse Rep
End Sub
'-----------------------------------------------
Private Sub Recurse(ByVal Chemin As String)
Dim hFindfile As Long
hFindfile = FindFirstFileA(Chemin & "*.*", FileFindData)
If Chemin <> "D:" Then
FindNextFileA hFindfile, FileFindData
If FindNextFileA(hFindfile, FileFindData) = 0 Then
FindClose hFindfile
Exit Sub
End If
End If
Do
Fichier = Chemin & Left$(FileFindData.cFileName, _
InStr(1, FileFindData.cFileName, vbNullChar) - 1)
If GetAttr(Fichier) And vbDirectory Then
Recurse Fichier & ""
Else
FileCopy Fichier, Dest _
& Split(Fichier, "")(UBound(Split(Fichier, "")))
End If
Loop While FindNextFileA(hFindfile, FileFindData)
FindClose hFindfile
End Sub
'-----------------------------------------------
Sub Créer_Répertoire_Dest(Chemin As String)
Dim Commande As String, Lecteur As String
Lecteur = Left(Chemin, 1)
ChDrive Lecteur
Commande = Environ("comspec") & " /c mkdir " & Chemin
Shell Commande, vbHide
End Sub
'---------------------------------------------------







"Infogroup" discussion :
eq#pv#
Bonjour à tous,

J'ai un répertoire "Rep" qui comporte des sous-répertoires avec une
arborescence à 4 ou 5 niveau, cela donne par ex.

Rep
Rep1
Rep11
Rep2
Rep21
Rep22
Rep23
Etc.

Tous ces répertoires et sous-répertoires comportent différents fichiers.
Je voudrais, via une macro, pour éviter de faire cela manuellement, copier
la totalité des fichiers dans un seul répertoire de destination
Rep_destination par ex.

Merci par avance pour votre aide

Cordialement

Infogroup



Publicité
Poster une réponse
Anonyme