Bonjour le monde,
Sous Vista, Excel 2003, j'ai sur mon PC un dossier "Trésorier" qui contient
des sous-dossiers (nombreux) et des fichiers (beaucoup), qui sont des .xls
mais pas seulement (.doc, .jpg, .txt aussi)
J'ai souvent besoin de trimballer tels ou tels fichiers pendant quelques
jours en les travaillant sur plusieurs bécanes sucessives. J'ai donc créé un
dossier "EN COURS" sur une clé USB.
Quand les fichiers sont "stabilisés" (fin provisoire d'une phase de boulot
sur eux), je les ramène sur mon ordi et je les range dans "C:\Trésorier" en
les supprimant de la clé USB. (où ils seront remplacés plus tard par une
nouvelle vague de fichiers d'actualité).

Normalement je fais ça "à la main" en utilisant couper coller de Windows
Explorer, mais comme il y en a beaucoup je voudrais procéder par une macro
qui vide"EN COURS" de tous ses fichiers et les remettent à leur place dans
"C:\Trésorier".

Quel code peut couper dans le dossier "EN COURS" le fichier "LesSous.xls"
récemment travaillé et le coller dans le dossier "C:\Trésorier\Banque" ? (en
écrasant bien sûr le fichier antérieur)
Précision : grâce à ceux qui aident ici (merci FdeCourt) j'ai eu une macro
Excel qui me liste sans problème dans une feuille Excel, la liste complète
des fichiers de "C\Trésorier" avec leur chemin d'accès complet, et idem pour
EN COURS évidemment. Mon seul problème (enfin je crois) est de couper coller
les fichiers nomades.

Et est ce que ça peut marcher avec les .doc, .jpg, .txt ?

J'espère que j'ai bien expliqué ?
Cordialement, Mabouille

Bonjour.
Utilise l'instruction Name. Si tu as des problèmes pour l'adapter à ton
code, publie celui-ci.
Cordialement.
Daniel
[..]

Bonjour,

La procédure ne prévoit qu'une clé d'installer au moment
de procéder.

La procédure suivante va recréer sur la clé le chemin indiqué
dans la procédure qui est le même que le répertoire à copier
"Chemin = "Users\DM\Documents\test1""
Si ce chemin existe déjà, elle ne touchera à rien. Elle fait seulement
ajouter les répertoires du chemin manquants.

Elle copiera tous les répertoires, sous-répertoires et fichiers du
répertoire "Test1" en écrasant si besoin sans rien demander.

À partir de cette procédure, il est facile de faire une routine
faisant l'inverse, de la clé au disque dur.

'-------------------------------------------
Sub test()
Dim LecteurSource As String, Prêt As Boolean
Dim LecteurDestination As String
Dim Chemin As String

'***********Variables à renseigner*********
LecteurSource = "c:\"
Chemin = "Users\DM\Documents\test1"
'*******************************************

LecteurDestination = RemovableDisk(LecteurSource)
If LecteurDestination <> "" Then
Prêt = EstPret(LecteurDestination)
If Prêt = False Then
MsgBox "Le lecteur amovible n'est pas prêt."
Exit Sub
End If
Else
MsgBox "Aucun disque amovible détecté."
Exit Sub
End If

'Création du répertoire si nécessaire
Creer_Chemin LecteurDestination, LecteurDestination & Chemin

'Copie des fichiers vers la destination
Commande = Environ("comspec") & " /c Xcopy /S/E/Y " & _
LecteurSource & Chemin & " " & LecteurDestination & Chemin & ""

Shell Commande, 0

End Sub

'-------------------------------------------
Function RemovableDisk(MonLecteur As String)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk")
For Each Objdisk In colDisks
'2 constante numérique pour disque dur "removable"
If Objdisk.DriveType = 2 Then
RemovableDisk = Objdisk.Name & "\"
Exit Function
End If
Next
End Function

'-------------------------------------------
Function EstPret(Lecteur As String)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
For Each objdrive In colDrives
If Lecteur = objdrive & "\" Then
If objdrive.IsReady = True Then
EstPret = objdrive.IsReady
End If
End If
Next
End Function
'-------------------------------------------
Sub Creer_Chemin(Racine, Chemin As String)
Dim Commande As String
'Crée le chemin indiqué si les répertoires ne
'sont pas présents. N'écrase rien !
ChDrive Racine
Commande = Environ("comspec") & " /c mkdir " & Chemin
Shell Commande, 0
End Sub
'-------------------------------------------





"mabouille" <pierre.garnier4> a écrit dans le message de groupe de
discussion : #7q7X2EwKHA.4196...
Bonjour le monde,
Sous Vista, Excel 2003, j'ai sur mon PC un dossier "Trésorier" qui contient
des sous-dossiers (nombreux) et des fichiers (beaucoup), qui sont des .xls
mais pas seulement (.doc, .jpg, .txt aussi)
J'ai souvent besoin de trimballer tels ou tels fichiers pendant quelques
jours en les travaillant sur plusieurs bécanes sucessives. J'ai donc créé un
dossier "EN COURS" sur une clé USB.
Quand les fichiers sont "stabilisés" (fin provisoire d'une phase de boulot
sur eux), je les ramène sur mon ordi et je les range dans "C:\Trésorier" en
les supprimant de la clé USB. (où ils seront remplacés plus tard par une
nouvelle vague de fichiers d'actualité).

Normalement je fais ça "à la main" en utilisant couper coller de Windows
Explorer, mais comme il y en a beaucoup je voudrais procéder par une macro
qui vide"EN COURS" de tous ses fichiers et les remettent à leur place dans
"C:\Trésorier".

Quel code peut couper dans le dossier "EN COURS" le fichier "LesSous.xls"
récemment travaillé et le coller dans le dossier "C:\Trésorier\Banque" ? (en
écrasant bien sûr le fichier antérieur)
Précision : grâce à ceux qui aident ici (merci FdeCourt) j'ai eu une macro
Excel qui me liste sans problème dans une feuille Excel, la liste complète
des fichiers de "C\Trésorier" avec leur chemin d'accès complet, et idem pour
EN COURS évidemment. Mon seul problème (enfin je crois) est de couper coller
les fichiers nomades.

Et est ce que ça peut marcher avec les .doc, .jpg, .txt ?

J'espère que j'ai bien expliqué ?
Cordialement, Mabouille

Bonjour,
Je ne vois pas , est ce que tu peux me donner une piste, un début de code,
pour cette utilisation de Name ?
Merci
Cordialement
Mabouille

"Daniel.C" <dcolardelleZZZ> a écrit dans le message de
news:6140
[..]

Bonjour,
Ce code est pas mal au dessus de ma compétence, mais j'ai commencé dès
réception (merci pour ta rapidité) à travailler dessus, prudemment pour ne
pas écraser mes "vrais" fichiers!

Toutefois je sens vaguement que je ferais bien de simplifier ma question:

Soit une version actualisée de 3 fichiers Fich1 Fich2 Fich 3 dans le dossier
ENCOURS de la clé USB branchée sur le PC et affectée au lecteur P:\
Chemins: P:\ENCOURS\Fich1 P:\ENCOURS\Fich2 P:\ENCOURS\Fich3

Soit sur mon PC un dossier C:\Trésorier avec les 2 sous dossiers
DossierA et DossierB
-DossierA contient une version "ancienne" de Fich1 et de Fich2,
Chemins : C:\Trésorier\DossierA\Fich1 et
C:\Trésorier\DossierA\Fich2
-DossierB contient une version ancienne de Fich3 (ce n'est pas pour
compliquer, c'est vraiment le cas type que j'ai)
Chemin : C:\Trésorier\DossierB\Fich3

Je cherche à faire une macro qui remplace dans C:\ les anciennes versions
des fichiers Fich1 Fich2 et Fich3 par les nouvelles versions de ces fichiers
situées dans la clé P:\ (et les enlève de la clé)
Voili voilà, est ce jouable ?
Cordialement,
Mabouille

"michdenis" <michdenis> a écrit dans le message de
news:4201
[..]

On Error Resume Next
FichierSource = "P:\ENCOURS\Fich"
FichierCible = C:\Trésorier\DossierA\Fich1
Kill FichierCible
Name FichierSource as FichierCible
On Error Goto 0
De même pour les autres fichiers
Daniel
[..]

Merci, c'est élégant, simple, et...ça marche! J'ai juste rajouté un Kill
FichierSource après 'Name....' pour nettoyer la clé.
Je vais rentrer ensuite ce bout de code dans ma macro, en ajoutant peut être
des sécurité ici ou là)
Cordialement
Mabouille


"Daniel.C" <dcolardelleZZZ> a écrit dans le message de
news:4908
[..]

Essaie ceci :

'-------------------------------------
Sub test()
Dim LecteurSource As String, Prêt As Boolean
Dim RépertoireSource As String, Source As String
Dim Arr(), Elt As Variant, Destination As String
Dim Chemin As String, Arr1 As Variant, Elt1 As Variant
Dim X As Integer

'***********Variables à renseigner*********
'Liste des fichiers à copier
Arr = Array("Fich1", "Fich2", "Fich3")
'Chemin du répertoire où sont les fichiers sans le lecteur
RépertoireSource = "EnCours\"
'Chaque élément du tableau Arr est copié dans
'le répertoire correspondant du tableau Arr1
Arr1 = Array("C:\Trésorier\DossierA\", "C:\Trésorier\DossierA\", "C:\Trésorier\DossierB\")
'*******************************************

LecteurSource = RemovableDisk(LecteurSource)
If LecteurSource <> "" Then
Prêt = EstPret(LecteurSource)
If Prêt = False Then
MsgBox "Le lecteur amovible n'est pas prêt."
Exit Sub
End If
Else
MsgBox "Aucun disque amovible détecté."
Exit Sub
End If

For Each Elt In Arr
Source = LecteurSource & RépertoireSource & Elt
Destination = Arr1(X)
X = X + 1
'Copie le fichier vers la destination
Commande = Environ("comspec") & " /c Copy /Y " & _
Source & Chemin & " " & Destination & Chemin & ""
Shell Commande, 0
Next

End Sub

'Trouve la lettre du lecteur de ta clé
'-------------------------------------
Function RemovableDisk(MonLecteur As String)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk")
For Each Objdisk In colDisks
'2 constante numérique pour disque dur "removable"
If Objdisk.DriveType = 2 Then
RemovableDisk = Objdisk.Name & "\"
Exit Function
End If
Next
End Function


'Vérifie si ta clé est prête pour l'opération.
'-------------------------------------
Function EstPret(Lecteur As String)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
For Each objdrive In colDrives
If Lecteur = objdrive & "\" Then
If objdrive.IsReady = True Then
EstPret = objdrive.IsReady
End If
End If
Next
End Function
'-------------------------------------

Un autre façon de procéder en utilisant des API de Windows

Tu exécutes la procédure Test en choisissant une des actions
suivantes : FO_MOVE ,FO_COPY , FO_DELETE, FO_RENAME
l'usage des WildCard est permis *.xls ou *.* ou "P*.xls"
Ce qui permet d'avoir une action respectivement sur :
A ) Tous les fichiers excel seulement "chemin\*.xls"
B ) Tous les fichiers contenu dans le répertoire "chemin\*.*"
C ) Tous les fichiers Excel dont le nom débute par la lettre P "chemin\p*.*"
D ) On peut aussi utiliser le WidCard "?" qui remplace un caractère
dans le nom du fichier à l'endroit désigné
Exemple : "Fichier1.xls" on pourrait écrire : "Chemin\Fichier?.xls" pour
obtenir tous les noms dont la racine est "fichier"+ un caractère .xls

'déclaration des variables, constantes et Api dans le haut d'un
'module standard :
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Const FO_MOVE = 1
Const FO_COPY = 2
Const FO_DELETE = 3
Const FO_RENAME = 4

Const FOF_SILENT = 4
Const FOF_NOCONFIRMATION = 10

Private Declare Function SHFileOperationA Lib "Shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long

Private Function CopieDossier(Source As String, Dest As String, _
Optional Action As Byte, Optional Animation As Boolean) As Boolean
Dim OpStruct As SHFILEOPSTRUCT

With OpStruct
.wFunc = Action
.pFrom = Source
.pTo = Dest
'POUR MESSAGE AVANT D'ÉCRASER : 4 AU LIEU DE 10
.fFlags = 4
End With
CopieDossier = IIf(SHFileOperationA(OpStruct), False, True)
End Function

'---------------------------------
Sub Test()

Dim Source As String
Dim Dest As String

Source = "c:\Users\DM\Documents\Test1\test\*.*"
Dest = "c:\Users\DM\Documents\Test1\"

If CopieDossier(Source, Dest, FO_COPY, True) Then
MsgBox "Opération réussie"
Else
MsgBox "Un problème fut rencontré."
End If
End Sub
'---------------------------------




"mabouille" <pierre.garnier4> a écrit dans le message de groupe de
discussion : #4swYHPwKHA.4636...
Bonjour,
Ce code est pas mal au dessus de ma compétence, mais j'ai commencé dès
réception (merci pour ta rapidité) à travailler dessus, prudemment pour ne
pas écraser mes "vrais" fichiers!

Toutefois je sens vaguement que je ferais bien de simplifier ma question:

Soit une version actualisée de 3 fichiers Fich1 Fich2 Fich 3 dans le dossier
ENCOURS de la clé USB branchée sur le PC et affectée au lecteur P:\
Chemins: P:\ENCOURS\Fich1 P:\ENCOURS\Fich2 P:\ENCOURS\Fich3

Soit sur mon PC un dossier C:\Trésorier avec les 2 sous dossiers
DossierA et DossierB
-DossierA contient une version "ancienne" de Fich1 et de Fich2,
Chemins : C:\Trésorier\DossierA\Fich1 et
C:\Trésorier\DossierA\Fich2
-DossierB contient une version ancienne de Fich3 (ce n'est pas pour
compliquer, c'est vraiment le cas type que j'ai)
Chemin : C:\Trésorier\DossierB\Fich3

Je cherche à faire une macro qui remplace dans C:\ les anciennes versions
des fichiers Fich1 Fich2 et Fich3 par les nouvelles versions de ces fichiers
situées dans la clé P:\ (et les enlève de la clé)
Voili voilà, est ce jouable ?
Cordialement,
Mabouille

"michdenis" <michdenis> a écrit dans le message de
news:4201
[..]

Bonjour,
Youpee , la macro est maintenant complète et marche totalement : elle fait
la liste des fichiers de la clé (EN COURS) et celle des dossiers de
C:\Trésorier\ (sous dossiers compris même à plusieurs niveaux, solution
trouvée sur internet ) avec les noms des fichiers déja classés. Puis elle
utilise ces listes pour établir si un fichier de En COURS est une nouvelle
version d'un fichier déja classé la macro, et dans ce cas elle le classe à
sa place (=annule et remplace) avec Rename (merci à toi).
A la fin je n'ai plus dans EN COURS que les fichiers vraiment nouveaux, ceux
là je les classe à la main, faut quand même bosser un peu que diable !!! Et
je n'aurai pas à le refaire si je me ressert de ces fichiers une autre fois.
Le rajout du Kill FichierSource était inutile.
Merci à toi et à tous ceux qui aident.
Cordialement
Pierre

"mabouille" <pierre.garnier4> a écrit dans le message de
news:5812
[..]

Y a-t-il une raison qui t'empêche de publier ta procédure finale ?
Peut-être cela donnerait des idées à d'autres qui ont un problème
semblable au tien !

Merci beaucoup michdenis,
Je vais décortiquer les codes que tu m'as envoyés pour tâcher de progresser
en vba car je pars d'un niveau bien au dessous d'eux. Où allez vous pêcher
ces instructions magiques, les amis ? Faut que je me fasse une biblio, et si
tu peux me conseiller là dessus aussi je suis preneur.
Ce n'est pas juste une formule, je vais vraiment le faire! (hé il y en a
quand même qui sont à ma portée, par ex les WidCard !)
Pour le moment j'ai réussi à résoudre mon problème, enfin ça a l'air, et je
remercie Daniel.C et toi pour avoir bien voulu me répondre aussi gentiment
que rapidement.
Cordialement,
Mabouille


"michdenis" <michdenis> a écrit dans le message de
news:9d45
[..]

Bonjour,
Non bien sûr, je le donne donc ci après. J' espère que ça passera sur le
fil, car c'est long.
Euh c'est un redoutable honneur, dans la mesure où j'ai pris parfois des
solutions certainement très "bourrin" faute de temps et surtout pour être
sûr de bien contrôler cette macro, qui pouvait mettre en danger les fichiers
!! S'il vous plaît soyez tous indulgents!!
Parmi les trucs bourrin je pense que la solution des Offset pourrait être
remplacée par un indexage des lignes parcourues dans les deux pages. Il y a
sûrement d'autres choses.

Par précaution avant de faire quoi que ce soit j'avais fait une sauvegarde
complète du contenu de la clé!!

Bon, action: la macro est dans un fichier "Gestion.xls" qui se trouve sur la
clé USB (comme ça on est sûr qu'elle est en place pour faire ce travail!) et
qui comprend aussi deux onglets appelés "Rép Général" et "Rép EN COURS".

J'ai mis le code dans trois modules, voici le contenu du premier:
================================================== =======
Sub PgmMaitre()

'crée d'abord les listes de dossiers et fichiers, par deux macros et un
complément.

InventaireENCOURS
' voir code plus loin, macro-fille qui fait l'inventaires du dossier "EN
COURS"
InventaireTOTAL
' voir code plus loin, fait l'inventaires du dossier "C:\Trésorier"
contenant tout, y compris une copie de "EN COURS"

'ensuite :
'le dossier "EN COURS", qui est la source, ne doit pas figurer dans la liste
des destinations
'aussi faut il éliminer toutes les adresses s'y référant dans la feuille
"Rép Général"
'on explore toutes les cellules de la colonne A jusqu'en bas de la liste
(test= 1ère cellule vide)
'pour repérer la présence de EN COURS et éliminer toute la ligne
correspondant.

Sheets("Rép Général").Activate
Range("A1").Select

Do While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Value Like ("*" & "EN COURS" & "*") Then
Selection.EntireRow.Delete
ActiveCell.Offset(-1, 0).Activate ' ça c'est parce que la ligne
active étant éliminée c'est la suivante qui devient la sélection
' il faut donc
remonter d'un cran la sélection sinon on loupe d'examiner cette ligne au
tour suivant
End If
Loop
'=========================================
'repérage des adresses du dossier "C:\Trésorier" où sont rangés les fichiers
se trouvant dans EN COURS s'ils ont déja été rangés une fois.

'pour cela on explore cellule par cellule la colonne C (nom des fichiers) de
la page Rép EN COURS
'pour chaque cellule on cherche si le fichier figure dans la colonne B de la
page Rép Général
'par précaution on parcourt la totalité de cette colonne, au cas où un même
fichier aurait deux adresses.

Sheets("Rép EN COURS").Activate
Range("C1").Select
Do While ActiveCell.Value <> ""
' ici on mémorise la date de modification et le nom du fichier qui sera peut
être à déplacer,

Sheets("Rép EN COURS").Activate
ActiveCell.Offset(1, 4).Activate ' va dans la colonne des dates
modif
DateModifSource = ActiveCell.Value
ActiveCell.Offset(0, -4).Activate 'retourne à la colonne des noms
FichRech = ActiveCell.Value 'vb pour chercher le fichier dans
l'autre page

' puis on recherche ce fichier d'après les noms listés dans Rép
Général
Sheets("Rép Général").Activate
Range("C1").Select

Do While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Activate

If ActiveCell.Value Like (FichRech) Then
'si on trouve le fichier on vérifie quelle est la version la plus fraîche
ActiveCell.Offset(0, 4).Activate
DateModifCible = ActiveCell.Value
ActiveCell.Offset(0, -4).Activate

If DateModifSource >= DateModifCible Then
'si le fichier de EN COURS est plus récent, on le range à la place de son
ancienne version.
DéplacementFichiers
'puis on revient à la liste
Sheets("Rép Général").Activate
End If

End If
Loop

Sheets("Rép EN COURS").Activate

Loop

End Sub
==========================================
' Sous Macro, également dans le premier module,
' sur une suggestion + code de Daniel.C

Sub DéplacementFichiers()

ActiveCell.Offset(0, -1).Activate
FichierCible = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate

Sheets("Rép EN COURS").Activate
ActiveCell.Offset(0, -1).Activate
FichierSource = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate

On Error Resume Next
Kill FichierCible
Name FichierSource As FichierCible
Kill FichierSource 'pas utile, mais je l'ai gardée

Sheets("Rép Général").Activate

End Sub
===========================================
' 2ème module, macro appelée au début du prgm maître:
' solution trouvée sur internet, adaptée de Ole P Erlandsen
' necessite d'activer la reference Microsoft Scripting RunTime: dans
l'editeur Visual Basic (alt+F11)
' aller dans le menu 'outils - références' et cocher Microsoft running...

Option Explicit

Sub InventaireENCOURS()

Sheets("Rép EN COURS").Select

'efface la liste précédente
Cells.Select
Selection.ClearContents
Range("A1").Select

'liste le contenu de EN COURS sur la clé USB
ListFilesInFolder "P:\Trésorier\EN COURS", True

End Sub

Sub ListFilesInFolder(strFolderName As String, bIncludeSubfolders As
Boolean)
Static fso As FileSystemObject
Dim oSourceFolder As Scripting.Folder
Dim oSubFolder As Scripting.Folder
Dim oFile As Scripting.file
Static wksDest As Worksheet
Static iRow As Long
Static bNotFirstTime As Boolean

If Not bNotFirstTime Then
Set wksDest = ActiveSheet
Set fso = CreateObject("Scripting.FileSystemObject")
'je n'ai pas eu besoin de tous, mais ici tous y sont
wksDest.Cells(1, 1) = "Parent folder"
wksDest.Cells(1, 2) = "Full path"
wksDest.Cells(1, 3) = "File name"
wksDest.Cells(1, 4) = "Size"
wksDest.Cells(1, 5) = "Type"
wksDest.Cells(1, 6) = "Date created"
wksDest.Cells(1, 7) = "Date last modified"
wksDest.Cells(1, 8) = "Date last accessed"
wksDest.Cells(1, 9) = "Attributes"
wksDest.Cells(1, 10) = "Short path"
wksDest.Cells(1, 11) = "Short name"

iRow = 2
bNotFirstTime = True
End If

Set oSourceFolder = fso.GetFolder(strFolderName)

For Each oFile In oSourceFolder.Files
wksDest.Cells(iRow, 1) = oFile.ParentFolder.Path
wksDest.Cells(iRow, 2) = oFile.Path
wksDest.Cells(iRow, 3) = oFile.Name
wksDest.Cells(iRow, 4) = oFile.Size
wksDest.Cells(iRow, 5) = oFile.Type
wksDest.Cells(iRow, 6) = oFile.DateCreated
wksDest.Cells(iRow, 7) = oFile.DateLastModified
wksDest.Cells(iRow, 8) = oFile.DateLastAccessed
wksDest.Cells(iRow, 9) = oFile.Attributes
wksDest.Cells(iRow, 10) = oFile.ShortPath
wksDest.Cells(iRow, 11) = oFile.ShortName

iRow = iRow + 1
Next oFile

If bIncludeSubfolders Then
For Each oSubFolder In oSourceFolder.subfolders
ListFilesInFolder oSubFolder.Path, True
Next oSubFolder
End If

End Sub
==================================================
' 3ème module, macro appelée au début du prgm maître:
' idem la précédente = adaptée de Ole P Erlandsen
Option Explicit

Sub InventaireTOTAL()

Sheets("Rép Général").Select

'efface toute la liste précédente
Cells.Select
Selection.ClearContents
Range("A1").Select

'liste le contenu de l'ensemble du répertoire Trésorier
ListFilesInFolder "C:\Trésorier", True

End Sub

Sub ListFilesInFolder(strFolderName As String, bIncludeSubfolders As
Boolean)

Static fso As FileSystemObject
Dim oSourceFolder As Scripting.Folder
Dim oSubFolder As Scripting.Folder
Dim oFile As Scripting.file
Static wksDest As Worksheet
Static iRow As Long
Static bNotFirstTime As Boolean

If Not bNotFirstTime Then
Set wksDest = ActiveSheet
Set fso = CreateObject("Scripting.FileSystemObject")
'je n'ai pas eu besoin de tous, mais ici tous y sont
wksDest.Cells(1, 1) = "Parent folder"
wksDest.Cells(1, 2) = "Full path"
wksDest.Cells(1, 3) = "File name"
wksDest.Cells(1, 4) = "Size"
wksDest.Cells(1, 5) = "Type"
wksDest.Cells(1, 6) = "Date created"
wksDest.Cells(1, 7) = "Date last modified"
wksDest.Cells(1, 8) = "Date last accessed"
wksDest.Cells(1, 9) = "Attributes"
wksDest.Cells(1, 10) = "Short path"
wksDest.Cells(1, 11) = "Short name"

iRow = 2
bNotFirstTime = True
End If

Set oSourceFolder = fso.GetFolder(strFolderName)

For Each oFile In oSourceFolder.Files
wksDest.Cells(iRow, 1) = oFile.ParentFolder.Path
wksDest.Cells(iRow, 2) = oFile.Path
wksDest.Cells(iRow, 3) = oFile.Name
wksDest.Cells(iRow, 4) = oFile.Size
wksDest.Cells(iRow, 5) = oFile.Type
wksDest.Cells(iRow, 6) = oFile.DateCreated
wksDest.Cells(iRow, 7) = oFile.DateLastModified
wksDest.Cells(iRow, 8) = oFile.DateLastAccessed
wksDest.Cells(iRow, 9) = oFile.Attributes
wksDest.Cells(iRow, 10) = oFile.ShortPath
wksDest.Cells(iRow, 11) = oFile.ShortName

iRow = iRow + 1
Next oFile
oSubFolder

If bIncludeSubfolders Then
For Each oSubFolder In oSourceFolder.subfolders
ListFilesInFolder oSubFolder.Path, True
Next oSubFolder
End If

End Sub
==============================================
Voilà, tout y est, j'espère avoir correctement recopié.
Je l'ai faite tourner deux fois déjà, apparemment sans problème.
Merci pour l'aide que j'ai reçue, et pour l'indulgence de ceux qui liront
ça!!
Bien entendu toute suggestion pour améliorer sont les bienvenus.
Cordialement
Mabouille

Merci.

Bonsoir,
Attention, je viens de trouver un petit bug: si un même fichier est classé
dans C\Trésorier à deux endroits différents et si on a fait une modif (donc
placée dans EN COURS), seule l' "ancienne" version trouvée en premier par la
macro sera mise à jour puisque le fichier est supprimé de EN COURS au 1er
coup. Donc ne pas utiliser cette macro telle quelle si on est dans ce cas, à
savoir = possibilité de copies du même fichier dans plusieurs emplacements
de C:\Trésorier. Ou sinon n'oubliez pas d'adapter le code.
Perso je n'ai ça que 2 ou 3 fois, donc je ne change rien, mais je vais
m'obliger à n'avoir qu'un exemplaire de chaque fichier, c'est d'ailleurs
plus "sain"!
Cordialement
Mabouille


"michdenis" <michdenis> a écrit dans le message de
news:3408
[..]