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 à 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 à 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" 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.
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" 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
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.
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" 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