Discussion :

[Ma7ay]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 =)

[Ma7ay]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 .

[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.

[Ma7ay]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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