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.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Philippe.R
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" a écrit dans le message de 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
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" <Infogroup70@orange.fr> a écrit dans le message de
news:eq%23pv%23sfJHA.1288@TK2MSFTNGP02.phx.gbl...
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.
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" a écrit dans le message de 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
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" a écrit dans le message de groupe de 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
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" <Infogroup70@orange.fr> a écrit dans le message de groupe de discussion :
eq#pv#sfJHA.1288@TK2MSFTNGP02.phx.gbl...
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.
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" a écrit dans le message de groupe de 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
Infogroup
Merci Philippe, je vais essayer de me débrouiller avec tous les exemples de frederic s.
Cordialement
Infogroup
"Philippe.R" <AS_rauphil_chez_wanadoo.fr> a écrit dans le message de 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" a écrit dans le message de 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
Merci Philippe, je vais essayer de me débrouiller avec tous les exemples de
frederic s.
Cordialement
Infogroup
"Philippe.R" <AS_rauphil_chez_wanadoo.fr> a écrit dans le message de
news:uUs3RyufJHA.4932@TK2MSFTNGP02.phx.gbl...
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" <Infogroup70@orange.fr> a écrit dans le message de
news:eq%23pv%23sfJHA.1288@TK2MSFTNGP02.phx.gbl...
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 Philippe, je vais essayer de me débrouiller avec tous les exemples de frederic s.
Cordialement
Infogroup
"Philippe.R" <AS_rauphil_chez_wanadoo.fr> a écrit dans le message de 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" a écrit dans le message de 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
Merci mille fois michdenis, et bravo pour le chef à 4 plumes.
C'est exactement le fonctionnement que j'attendais.
Merci encore
Cordialement
Infogroup
"michdenis" a écrit dans le message de 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" a écrit dans le message de groupe de 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
Merci mille fois michdenis, et bravo pour le chef à 4 plumes.
C'est exactement le fonctionnement que j'attendais.
Merci encore
Cordialement
Infogroup
"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:6523124F-2FF2-45B5-9401-E00A43EB7CDE@microsoft.com...
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" <Infogroup70@orange.fr> a écrit dans le message de groupe de
discussion :
eq#pv#sfJHA.1288@TK2MSFTNGP02.phx.gbl...
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 mille fois michdenis, et bravo pour le chef à 4 plumes.
C'est exactement le fonctionnement que j'attendais.
Merci encore
Cordialement
Infogroup
"michdenis" a écrit dans le message de 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" a écrit dans le message de groupe de 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.
