Macro Excel gestion de dossier

Version imprimable

Bonjour tout le monde!

Alors je viens ici pour avoir de l'aide de votre part =)
Je vous explique ce que je souhaite faire.
Je souhaite créer une macro Excel qui me permettra d'afficher dans des cellules le chemin d'un dossier, sa taille, sa date de dernière modification et son propriétaire.
Le dossier en question sera choisi préalablement grâce à l'exploreur Windows. Etant (très) débutant en la matière je suis en plein galère. Je vous montre ce que j'ai fait et où j'en suis
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 Sub GestionFichier() Dim Repertoire As FileDialog Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker) Repertoire.Show 'Affiche le chemin du répertoire MsgBox Repertoire.SelectedItems(1) 'Affichage de la date de création d'un certain dossier MsgBox GestionFichier.GetFolder("").DateCreated Set GestionDossier = Nothing 'Date du dernier acces MsgBox GestionFichier.GetFolder("").DateLastAccessed 'taille du dossier MsgBox GestionFichier.GetFolder("").Size 'afficher proprietaire du dossier 'MsgBox End Sub
J'ai trouvé la plupart des fonction sur Internet mais j'arrive vraiment pas à me dépatouiller. J'ai vraiment besoin de votre aide =)

Merci d'avance à ceux qui prendront le temps de m'aider.
Matt

En fait j'ai besoin de 4 fonction : DateLastModified, Size, Path, (propriétaire du dossier)

Mais je ne sais pas/n'arrive pas à les utiliser correctement dans mon cas.

Merci =)

Personne pour me donner un petit coup de pouce

Même si c'est juste le début ça m'aidera beaucoup

Juste que je puisse choisir mon répertoire et l'afficher dans une cellule d'Excel

J'ai écrit ca mais ça ne marche pas :
Code:

1 2 3 4 5 6 'Selection du répertoire Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker) Repertoire.Show Workbooks.Open Repertoire Sheets("feuil1").Select Range("A1").Value = Repertoire

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim stFichier
Dim oShell
Dim oFolder
Dim oFichier
Dim I As Long
Dim Resultat As String
stRep = "C:\"
stFichier = "Fichier.txt"
Resultat = ""
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.Namespace(stRep)
Set oFichier = oFolder.Items.Item(stFichier)
'Affiche les propriétés étendues du fichier
For I = 0 To 34
 Resultat = Resultat & "[" & I & "] " & oFolder.GetDetailsOf(oFolder.Items, I) & " : " & oFolder.GetDetailsOf(oFichier, I) & vbCrLf
Next
MsgBox Resultat

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
sub test()
dim Rep as string
dim fichier as string
Rep =RetournRep
fichier=RetournFichier
end sub
Function RetournRep() As String
 
Dim objShell As Object, objFolder As Object
Dim SecuriteSlash As Integer
 
Set objShell = CreateObject("Shell.Application") 'recuperer nom repertoire cible
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
 
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path
If objFolder.Title = "" Then Chemin = ""
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
RetournRep = Chemin
End Function
Function RetournFichier() As String
Dim Resultat As String, MonAppli As String, LeFichier As String
 
'Définit les types d'informatins à récupérer
Tableau = Array("Name", "comments ", "CompanyName", "FileDescription", _
"FileVersion", "InternalName", "LegalCopyright", "legalTrademarks", _
"privateBuild", "OriginalFileName", "ProductName", _
"productVersionNum", "ProductVersion")
 
'Affiche un boîte de dialogue pour sélectionner un fichier sur le PC
 
X = Application.GetOpenFilename
'On sort si aucun fichier n'est sélectionné ou si vous avez appuyé
'sur le bouton "Annuler".
If X = False Then Exit Function
RetournFichier = X
End Function

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon False
Public Function Repertoires_Existe_RD(Repertoires As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(Repertoires) Then Repertoires_Existe_RD = True
Set fso = Nothing
End Function
 
'Crée un répertoire, dont l'emplacement et le nom sont précisé par le chemin d'accès complet précisé en argument (NewRepertoires).
Public Sub Creer_Repertoires_RD(NewRepertoires As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim T
Dim R As String
Dim I As Long
R = ""
T = Split(NewRepertoires & "\", "\")
For I = 0 To UBound(T)
    If Trim("" & T(I)) <> "" Then
        R = R & Trim("" & T(I)) & "\"
        If Repertoires_Existe_RD(R) = False Then fso.CreateFolder R
    End If
Next
Set fso = Nothing
End Sub
 
'Copie un répertoire, ainsi que tous les fichiers et sous-répertoires qu'il contient, d'une source vers une destination.
Public Sub Copie_Repertoires_RD(Source As String, Destination As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFolder Source, Destination, True
Set fso = Nothing
End Sub
 
'Déplace un ou plusieurs répertoire d'un emplacement source vers une destination.
Public Sub Deplace_Repertoire_RD(Source As String, Destination As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFolder Source, Destination
Set fso = Nothing
End Sub
 
'Permet de supprimer un répertoire et tous les fichiers et sous-répertoires qu'il contient.
Public Sub Supprimer_Repertoire_RD(DelRepertoire As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder DelRepertoire, True
Set fso = Nothing
End Sub
'Retourne le répertoire parent d'un répertoire :
Public Function repertoire_Parent_repertoire_RD(Rep As String)
Dim fso As Object
If Repertoires_Existe_RD(Rep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    repertoire_Parent_Fichier_RD = fso.GetFolder(Rep).ParentFolder
    If Err <> 0 Then repertoire_Parent_Fichier_RD = Rep
    Set fso = Nothing
End If
End Function
'Retourne la taille d'un répertoire :
Public Function Taille_repertoire_RD(TailleRep As String)
Dim fso As Object
If Repertoires_Existe_RD(TailleRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Taille_repertoire_RD = fso.GetFile(TailleRep).Size
    Set fso = Nothing
End If
End Function
'Retourne la date de modification   d'un répertoire :
Public Function Modification_repertoire_RD(ModifRep As String)
Dim fso As Object
If Repertoires_Existe_RD(ModifRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Modification_repertoire_RD = fso.GetFile(CreeRep).DateLastModified
    Set fso = Nothing
End If
End Function
'Retourne la date de création  d'un répertoire :
Public Function Cree_repertoire_RD(CreeRep As String)
Dim fso As Object
If Repertoires_Existe_RD(CreeRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Cree_repertoire_RD = fso.GetFile(CreeRep).DateCreated
    Set fso = Nothing
End If
End Function
 
'Vérifie l'existence d'un fichier
Function Fichier_Existe_RD(FichierExiste)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
   Fichier_Existe_RD = fso.FileExists(FichierExiste)
Set fso = Nothing
End Function
 
'Copie un fichier d'une source vers une destination.
Public Sub Copie_Fichier_RD(Source As String, Destination As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile Source, Destination, True
Set fso = Nothing
End Sub
 
'Déplace un ou plusieurs fichiers d'un emplacement source vers une destination.
Public Sub Deplace_Fichier_RD(Source As String, Destination As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile Source, Destination
Set fso = Nothing
End Sub
 
'Supprime le ou les fichiers dont le nom est précisé en argument.
Public Sub Supprimer_Fichier_RD(DelFichier As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile DelFichier, True
Set fso = Nothing
End Sub
'Retourne le répertoire d'un fichier :
Public Function repertoire_Parent_Fichier_RD(RepFichier As String)
Dim fso As Object
If Fichier_Existe_RD(RepFichier) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    repertoire_Parent_Fichier_RD = fso.GetFile(RepFichier).ParentFolder
    Set fso = Nothing
End If
End Function
'Retourne la taille d'un fichier :
Public Function Taille_Fichier_RD(TailleFichier As String)
Dim fso As Object
If Fichier_Existe_RD(TailleFichier) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Taille_Fichier_RD = fso.GetFile(TailleFichier).Size
    Set fso = Nothing
End If
End Function
 
'Retourne La date de création  d'un fichier :
Public Function Creation_Fichier_RD(CreaeFichier As String)
Dim fso As Object
If Fichier_Existe_RD(CreaeFichier) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Creation_Fichier_RD = fso.GetFile(CreaeFichier).DateCreated
    Set fso = Nothing
End If
End Function
'Retourne La date de modification  d'un fichier :
Public Function Modification_Fichier_RD(MidifierFichier As String)
Dim fso As Object
If Fichier_Existe_RD(MidifierFichier) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Creation_Fichier_RD = fso.GetFile(MidifierFichier).DateCreated
    Set fso = Nothing
End If
End Function

08/03/2013, 13h17
Ma7ay

Wow merci beaucoup de se balèze de code !
Je vais regarder de plus près ce que tu as fais et tenté de comprendre puis je reviendrai ici ;)

En tout cas merci beaucoup pour ton intérêt c'est vraiment appréciable .
08/03/2013, 13h45
Invité

De rien j’ai concocté ces infos aux files des ans, le plus long était de les retrouver.
Je n’ai pas fait une ligne de code aujourd’hui.

Alors j'ai bien regardé un peu ce que tu as mis et ce qui m'interesse sont les fonctions suivantes:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
'Retourne la taille d'un répertoire :
Public Function Taille_repertoire_RD(TailleRep As String)
Dim fso As Object
If Repertoires_Existe_RD(TailleRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Taille_repertoire_RD = fso.GetFile(TailleRep).Size
    Set fso = Nothing
End If
End Function
 
'Retourne la date de modification   d'un répertoire :
Public Function Modification_repertoire_RD(ModifRep As String)
Dim fso As Object
If Repertoires_Existe_RD(ModifRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Modification_repertoire_RD = fso.GetFile(CreeRep).DateLastModified
    Set fso = Nothing
End If
End Function
 
'Retourne la date de création  d'un répertoire :
Public Function Cree_repertoire_RD(CreeRep As String)
Dim fso As Object
If Repertoires_Existe_RD(CreeRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Cree_repertoire_RD = fso.GetFile(CreeRep).DateCreated
    Set fso = Nothing
End If
End Function

J'ai le début de mon code qui me permet de sélectionner le dossier que je veux :

Code:

1
2
3
4
5
6
7
8
9
10
11
 
Sub GestionFichier()
Dim Repertoire As FileDialog
 
'Selection du répertoire
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
 
 
'Affiche le chemin du répertoire
MsgBox Repertoire.SelectedItems(1)

Ma question est, comment faire pour intégrer les 3 fonctions si dessus pour qu'elles prennent les infos du dossier que j'ai sélectionné et placer les résultats dans des cellules Excel ?

Je te remercie d'avance =)
Matt

Code:

MsgBox Cree_repertoire_RD(Repertoire.SelectedItems(1))

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub GestionFichier()
Dim Repertoire As FileDialog
Dim Rep As String
Dim Resultat As String
'Selection du répertoire
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
 
 
'Affiche le chemin du répertoire
Rep = Repertoire.SelectedItems(1)
Resultat = "Taille : " & Taille_repertoire_RD(Rep) & vbCrLf
Resultat = Resultat & "Créer : " & Cree_repertoire_RD(Rep) & vbCrLf
Resultat = Resultat & "modifié : " & Modification_repertoire_RD(Rep) & vbCrLf
Range("A1") = Resultat

Ceci dit garde toutes les fonctions de dossiers & fichier ça peut servir !

Oui j'ai tout mis ça de côté, si un jour je dois m'en servir je les auraient sous la main =).

Quand j'exécute ma macro il me dit "Tableau attendu" au niveau de la ligne 17. Je dois rajouter un "WorkBooks" ou quelques chose comme ça pour intégrer les résultat dans les cellules ?
(Désolé de toutes ces questions qui pourraient paraître un peu anodin mais je débute le VBA Excel que depuis hier.)

Merci d'avance

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub GestionFichier()
Dim Repertoire As FileDialog
Dim Rep As String
Dim Resultat As String
Dim Repertoires_Existe_RD As String
Dim Taille_repertoire_RD As String
 
 
 
'Selection du répertoire
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
 
 
'Affiche le chemin du répertoire
Rep = Repertoire.SelectedItems(1)
Resultat = "Taille : " & Taille_repertoire_RD(Rep) & vbCrLf
Resultat = Resultat & "Créer : " & Cree_repertoire_RD(Rep) & vbCrLf
Resultat = Resultat & "modifié : " & Modification_repertoire_RD(Rep) & vbCrLf
Range("A1") = Resultat
 
End Sub
 
'Retourne la taille d'un répertoire :
Public Function Taille_repertoire_RD(TailleRep As String)
Dim fso As Object
If Repertoires_Existe_RD(TailleRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Taille_repertoire_RD = fso.GetFile(TailleRep).Size
    Set fso = Nothing
End If
End Function
 
'Retourne la date de modification   d'un répertoire :
Public Function Modification_repertoire_RD(ModifRep As String)
Dim fso As Object
If Repertoires_Existe_RD(ModifRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Modification_repertoire_RD = fso.GetFile(CreeRep).DateLastModified
    Set fso = Nothing
End If
End Function
 
'Retourne la date de création  d'un répertoire :
Public Function Cree_repertoire_RD(CreeRep As String)
Dim fso As Object
If Repertoires_Existe_RD(CreeRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Cree_repertoire_RD = fso.GetFile(CreeRep).DateCreated
    Set fso = Nothing
End If
End Function

Elle est bonne, je demande des infos pour un répertoire et j’encode pour un fichier ?????

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
'Retourne la taille d'un répertoire :
Public Function Taille_repertoire_RD(TailleRep As String)
Dim fso As Object
If Repertoires_Existe_RD(TailleRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Taille_repertoire_RD = fso.GetFolder(TailleRep).Size
    Set fso = Nothing
End If
End Function
 
'Retourne la date de modification   d'un répertoire :
Public Function Modification_repertoire_RD(ModifRep As String)
Dim fso As Object
If Repertoires_Existe_RD(ModifRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Modification_repertoire_RD = fso.GetFolder(ModifRep).DateLastModified
    Set fso = Nothing
End If
End Function
 
'Retourne la date de création  d'un répertoire :
Public Function Cree_repertoire_RD(CreeRep As String)
Dim fso As Object
If Repertoires_Existe_RD(CreeRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Cree_repertoire_RD = fso.GetFolder(CreeRep).DateCreated
    Set fso = Nothing
End If
End Function

08/03/2013, 16h22
Ma7ay

En fait je veux juste une macro pour automatiser le tout et pas faire manuellement clic droit > propriété > taille > etc ....
Et tout ça dans un tableau excel =)

C'est le fait de renvoyer tous les résultats des fonctions dans un tableau qui me pose problème =(

On est deux tu as déclaré mes fonction en string voilà l’erreur de tableau, ceci dit j’en avais fait une on est à 1 partout !

Code:

1
2
Dim Repertoires_Existe_RD As String
Dim Taille_repertoire_RD As String

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub GestionFichier()
Dim Repertoire As FileDialog
Dim Rep As String
Dim Resultat As String
 
 
'Selection du répertoire
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
 
 
'Affiche le chemin du répertoire
Rep = Repertoire.SelectedItems(1)
Resultat = "Taille : " & Taille_repertoire_RD(Rep) & vbCrLf
Resultat = Resultat & "Créer : " & Cree_repertoire_RD(Rep) & vbCrLf
Resultat = Resultat & "modifié : " & Modification_repertoire_RD(Rep) & vbCrLf
Range("A1") = Resultat
 
End Sub
 
'Retourne la taille d'un répertoire :
Public Function Taille_repertoire_RD(TailleRep As String)
Dim fso As Object
If Repertoires_Existe_RD(TailleRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Taille_repertoire_RD = fso.GetFolder(TailleRep).Size
    Set fso = Nothing
End If
End Function
 
'Retourne la date de modification   d'un répertoire :
Public Function Modification_repertoire_RD(ModifRep As String)
Dim fso As Object
If Repertoires_Existe_RD(ModifRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Modification_repertoire_RD = fso.GetFolder(ModifRep).DateLastModified
    Set fso = Nothing
End If
End Function
 
'Retourne la date de création  d'un répertoire :
Public Function Cree_repertoire_RD(CreeRep As String)
Dim fso As Object
If Repertoires_Existe_RD(CreeRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Cree_repertoire_RD = fso.GetFolder(CreeRep).DateCreated
    Set fso = Nothing
End If
End Function
 
'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon False
Public Function Repertoires_Existe_RD(Repertoires As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(Repertoires) Then Repertoires_Existe_RD = True
Set fso = Nothing
End Function

08/03/2013, 16h53
Ma7ay

C'est super ça marche !

Me manque juste un truc, c'est de pouvoir insérer le chemin complet de mon dossier dans une cellule aussi et répéter l'opération x fois (je pense qu'il faut mettre le tout dans une boucle?) et je suis tout bon =)

Je te remercie grandement !!!

Edit : J'ai réussi a mettre le chemin
Me manque plus qu'a bouclé le tout pour pouvoir rajouter d'autre info dossier sur les ligne d'en dessous

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Sub GestionFichier()
Dim Repertoire As FileDialog
Dim Rep As String
Dim Resultat As String
Dim Sortir As Boolean
On Error GoTo Fin
Do While Sortir = False
'Selection du répertoire
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
 
 
'Affiche le chemin du répertoire
Rep = Repertoire.SelectedItems(1)
Resultat = "Répertoire : " & Rep & vbCrLf
Resultat = Resultat & "Taille : " & Taille_repertoire_RD(Rep) & vbCrLf
Resultat = Resultat & "Créer : " & Cree_repertoire_RD(Rep) & vbCrLf
Resultat = Resultat & "modifié : " & Modification_repertoire_RD(Rep) & vbCrLf
Cells(Range("A1").CurrentRegion.Rows.Count + 1, 1) = Resultat
If MsgBox("Voulez vous continué?", vbYesNo + vbQuestion) = vbNo Then Sortir = True
Loop
Fin:
End Sub
 
'Retourne la taille d'un répertoire :
 
Public Function Taille_repertoire_RD(TailleRep As String)
 
Dim fso As Object
If Repertoires_Existe_RD(TailleRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Taille_repertoire_RD = fso.GetFolder(TailleRep).Size
    Set fso = Nothing
End If
End Function
 
'Retourne la date de modification   d'un répertoire :
Public Function Modification_repertoire_RD(ModifRep As String)
Dim fso As Object
If Repertoires_Existe_RD(ModifRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Modification_repertoire_RD = fso.GetFolder(ModifRep).DateLastModified
    Set fso = Nothing
End If
End Function
 
'Retourne la date de création  d'un répertoire :
Public Function Cree_repertoire_RD(CreeRep As String)
Dim fso As Object
If Repertoires_Existe_RD(CreeRep) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Cree_repertoire_RD = fso.GetFolder(CreeRep).DateCreated
    Set fso = Nothing
End If
End Function
 
'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon False
Public Function Repertoires_Existe_RD(Repertoires As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(Repertoires) Then Repertoires_Existe_RD = True
Set fso = Nothing
End Function

08/03/2013, 17h08
Ma7ay

C'est génial le tout marche comme je le souhaite!

Un très grand merci à tout pour ta patience et ton aide, j'ai beaucoup appris aujourd'hui grâce à toi =D.

Matt
03/09/2013, 09h45
Ma7ay

1 pièce(s) jointe(s)

Bonjour à tous!

Je ressors ce sujet pour une petite mise à jour de ma macro Excel.
A la base le but de ma macro était d'afficher certaine propriétés d'un dossier spécifique, cela marche très bien.

Maintenant je voudrais exactement la même chose mais en listant les dossier d'un répertoire choisi.

Par exemple je choisi un répertoire Bêta qui contient des dossiers et en exécutant ma macro je souhaite qu'elle me liste tous les dossiers (pas les fichiers) du répertoire Bêta.

Je galère un peu pour faire cette boucle (Do While ??)

Je vous joint ma macro actuelle.

Je vous remercie de votre aide par avance =)

Matt
03/09/2013, 10h45
Invité

1 pièce(s) jointe(s)

Bonjour, test ça
03/09/2013, 11h01
Ma7ay

1 pièce(s) jointe(s)

Merci grandement de ta réponse Rdurupt.

J'ai testé ta macro mais cela ne m'affiche que le chemin de mon dossier selectionné, quand j'utilise ton nouveau bouton.

Voila ou j'en suis. J'ai réussi à lister tous les dossiers d'un dossier mais je n'arrive pas à intégrer les propriétés des dossier dans la boucle.

J'y suis presque je pense

Matt
03/09/2013, 11h16
Invité

1 pièce(s) jointe(s)

tu n'avais pas intégré ma macro.