WScript.Shell récuperer la date de modif avec la commande DIR

Version imprimable

Bonjour à tous

J'ai fait un mixe entre

list-all-files-fast-way-in-subfolders-without-filesystemobject
hide-command-prompt-window-when-using-exec/

pour obtenir la liste des répertoires/fichiers
Code:

1 2 3 4 5 6 ' Using a hidden window, pipe the output of the command to the CLIP.EXE utility Dim results as string CreateObject("WScript.Shell").Run "CMD /C DIR """ & parentFolder & "*.*"" w/a/s /b /d/t | clip", 0, True results = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text") Range("D1").Resize(UBound(Split(results, vbCrLf)), 1).Value = WorksheetFunction.Transpose(Split(results, vbCrLf))
J'obtiens chemin et le nom

Des fichiers
Des répertoires

Mais rien sur les attributs associés comme :

La date de dernière modification
La taille du fichier / répertoire

Merci par avance pour toute aide
Bonjour chez vous :pingoin2:

24/01/2017, 00h38
RyuAutodidacte

bonsoir,

je suis pas à l'aise avec les commandes windows, mais ceci peut peut-être intéresser :
PS : par contre c'est un Batch mais peut être qu'il y a des indices ou moyen d'adapter ??

- Connaître taille dossier

A voir ?? - cela peut donner des infos supp : Gestion de fichiers
24/01/2017, 02h35
clementmarcotte

Avec quelque chose de moderne comme le Framework .net (VB.net, C# et d'autres langages compatibles), cela se fait les yeux fermés, ou presque. Même que tu l'avoir en "temps local" et en "temps UTC"

Avec des fichiers Office, tu as juste à écumer les BuiltInDocumentProperties, ou utiliser DSOFile

Même que le temps d'apprendre à le faire en VB.net (copier-coller les exemples de l'aide, ou même télécharger un exemple tout fait) serait moins long que d'apprendre à faire tous tes raboutages.

Et puis avec quelque chose de moderne et pas mas plus sécure que l'API Windows comme le Framework.net, tu peux calculer la taille des dossiers par addition des tailles de fichiers, de manière asynchrone, ou même dans un thread distinct.

Et puis avec quelque chose de moderne et pas mas plus sécure que l'API Windows comme le Framework.net, la récursivité est préimplantée.
24/01/2017, 07h56
informer

Bonjour à tous et merci pour votre aide.

Bon s'il faut faire un batch DOS çà m'amène trop loin... Je laisse ouvert au cas ou un membre voudrait finir l'exercice... Qui sait

Bonjour chez vous :pingoin2:
24/01/2017, 10h03
RyuAutodidacte

Bonjour,
Sur le 1er lien que j'ai donné j'ai testé sur l'invite de commande, une ligne en mettant le chemin d'un dossier (En mode PC cette fois ci) il m'a donné tous les poids se trouvant à l'intérieur du dossier (mais pas les chemin).
Je pense qu'avec la bonne configuration (à trouver …) en ligne de commande on peut obtenir le résultat voulu.

Moi perso, j'aurais utilisé un bon vieux dir récursif (vba, très efficace) avec les paramètres voulu, puis à partir des chemins, récupérer dates et tailles sur chaque chemins trouvé que ça soit avec du Shell, len … etc , ce qui me paraîtra le plus efficace en tout cas

D'ailleurs pour info @unparia a déposé un code sur le dir dans les contrib

j'ai l'impression que sur les commandes unix on est mieux lotis, mais c'est qu'une impression.

Par contre j'ai vu sur le net qu'il exister un moyen de rajouter des commandes pour l'invite, style unix comme par exemple du, mais je suis incapable de dire si c'est du solide ,
si qq un peut nous en dire plus là dessus …
Merci d'avance

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub test()
Dim WinExp As New clsWindowsExporer
Set a = WinExp.DatesRepertoire("C:\MyRepertoire")
Debug.Print a("DateCreated")
Debug.Print a("DateLastAccessed")
Debug.Print a("DateLastModified")
Debug.Print a("Erreur")
Set a = WinExp.DatesFichier("C:\MyRepertoire\MyFichier.xlsx")
Debug.Print a("DateCreated")
Debug.Print a("DateLastAccessed")
Debug.Print a("DateLastModified")
Debug.Print a("Erreur")
End Sub

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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
Public Function DatesRepertoire(Repertoire)
Set v = CreateObject("Scripting.Dictionary")
Dim fso
v("Erreur") = True
v("DateLastAccessed") = ""
v("DateLastModified") = ""
If Repertoires_Existe(Repertoire) = True Then
     With CreateObject("Scripting.FileSystemObject").GetFolder(Repertoire)
     On Error Resume Next
        v("DateCreated") = .DateCreated
        v("DateLastAccessed") = .DateLastAccessed
        v("DateLastModified") = .DateLastModified
        v("Erreur") = False
        On Error GoTo 0
    End With
End If
Set Datesepertoire = v
End Function
Public Function DatesFichier(Fichier) As Variant
Set v = CreateObject("Scripting.Dictionary")
Dim fso
v("Erreur") = True
v("DateLastAccessed") = ""
v("DateLastModified") = ""
If Fichier_Exist(Fichier) = True Then
     With CreateObject("Scripting.FileSystemObject").GetFile(Fichier)
     On Error Resume Next
        v("DateCreated") = .DateCreated
        v("DateLastAccessed") = .DateLastAccessed
        v("DateLastModified") = .DateLastModified
        v("Erreur") = False
        On Error GoTo 0
    End With
End If
Set DatesFichier = v
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(Repertoires)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Repertoires_Existe = fso.FolderExists(Repertoires)
Set fso = Nothing
End Function
'Taille d'un rÃ©pertoire
Public Function Taille_Repertoire(Repertoire)
Dim fso
Dim Rep
Set fso = CreateObject("Scripting.FileSystemObject")
    Set Rep = fso.GetFolder(Repertoire)
    Taille_Repertoire = Rep.Size
End Function
Function Repertoire_Date_Creation(Repertoire)
  Dim fso
Dim Rep
Set fso = CreateObject("Scripting.FileSystemObject")
    Set Rep = fso.GetFolder(Repertoire)
    Repertoire_Date_Creation = Rep.DateCreated
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(NewRepertoires)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim t
Dim R
Dim I
R = ""
t = Split(NewRepertoires & "\", "\")
For I = 0 To UBound(t) - 1
    If Trim("" & t(I)) <> "" Then
        R = R & Trim("" & t(I))
        If Repertoires_Existe(R) = False Then fso.CreateFolder "" & R
    End If
     R = R & "\"
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(Source, Destination)
Dim fso
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 Function Deplace_Repertoire(Source, Destination)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fso.MoveFolder Source, Destination
If Err > 0 Then Deplace_Repertoire = Err.Description
Err.Clear
On Error GoTo 0
Set fso = Nothing
End Function
'Permet de supprimer un rÃ©pertoire et tous les fichiers et sous-rÃ©pertoires qu'il contient.
Public Sub Supprimer_Repertoire(DelRepertoire)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder DelRepertoire, True
Set fso = Nothing
End Sub
'Taille d'un rÃ©pertoire
Public Function Taille_Fichier(Fichier)
Dim fso
Dim Fich
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fich = fso.GetFile(Fichier)
    Taille_Fichier = Fich.Size
End Function
'VÃ©rifie lexistance d'un   fichier
Public Function Fichier_Exist(Fichier)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_Exist = fso.FileExists(Fichier)
Set fso = Nothing
End Function
'Retourne le nom du fichier, Ã  partir du chemin d'accÃ¨s complet prÃ©cisÃ© en paramÃ¨tre.
Public Function Fichier_Name(Fichier)
Dim fso
If Fichier_Exist(Fichier) = True Then
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_Name = fso.GetBaseName(Fichier)
Set fso = Nothing
End If
End Function
'Retourne l'extension du fichier, Ã  partir du chemin d'accÃ¨s complet prÃ©cisÃ© en paramÃ¨tre.
Public Function Fichier_extension(Fichier)
Dim fso
If Fichier_Exist(Fichier) = True Then
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_extension = fso.GetExtensionName(Fichier)
Set fso = Nothing
End If
End Function
'Copie un fichier d'une source vers une destination.
Public Sub Copie_Fichier(Source, Destination)
Dim fso
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(Source, Destination)
Dim fso
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(DelFichier)
If Fichier_Exist(DelFichier) = True Then
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile DelFichier, True
Set fso = Nothing
End If
End Sub
Function AppendTxt(sFile, sText)
Dim fso, NewFichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(sFile, 8)
NewFichier.Write sText
NewFichier.Close
Set NewFichier = Nothing
Set fso = Nothing
End Function
Public Sub FichierLog(sFile, txt)
Dim FichierLog, fso
FichierLog = sFile
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(FichierLog) = False Then EnteteFichier FichierLog
AppendTxt FichierLog, txt
Set fso = Nothing
End Sub
Private Sub EnteteFichier(Fichier)
Dim txt, fso, NewFichier
txt = "***********************************************************************************************************************************************************************************"
txt = txt & vbCrLf
txt = txt & ""
txt = txt & vbCrLf
txt = txt & "   Date de crÃ©ation: " & Day(Now) & "/" & Month(Now) & "/" & Year(Now) & " " & Hour(Time) & ":" & Minute(Time) & vbCrLf
txt = txt & vbCrLf
txt = txt & "   " & Fichier
txt = txt & vbCrLf
txt = txt & "***********************************************************************************************************************************************************************************"
txt = txt & vbCrLf
txt = txt & vbCrLf
txt = ""
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Fichier, 2, True)
NewFichier.Write txt
NewFichier.Close
Set NewFichier = Nothing
Set fso = Nothing
End Sub
Public Function OuvrirFichier(Fichier)
Set oFs = CreateObject("Scripting.FileSystemObject")
Set oFile = oFs.OpenTextFile(Fichier)
OuvrirFichier = Split(oFile.ReadAll, vbCrLf)
oFile.Close
End Function

24/01/2017, 10h55
Marc-L

Bonjour !

Citation:

Envoyé par informer

Bon s'il faut faire un batch DOS çà m'amène trop loin...

Il s'agit juste de lancer une unique commande DOS via le VBA !
Et il y a même déjà des exemples sur ce forum comme sur d'autres …

_________________________________________________________________________________________________________
Je suis Paris, Istanbul, Berlin, Nice, Bruxelles, Charlie, …
24/01/2017, 12h18
informer

Merci à tous pour votre contribution et quant à appeler un batch, là n'est pas le problème, c'est qu'il faut aussi taper dans la programmation DOS, ça commence à faire beaucoup de couches memes si sommes en hivers:aie:

Surtout que in fine, tout ça doit être chargé dans access, donc la sortie DOS doit être facile à traiter.

Bonjour chez vous :pingoin2:
24/01/2017, 12h41
unparia

Citation:

Merci à tous pour votre contribution et quant à appeler un batch, là n'est pas le problème, c'est qu'il faut aussi taper dans la programmation DOS, ça commence à faire beaucoup de couches memes si sommes en hivers

Surtout que in fine, tout ça doit être chargé dans access, donc la sortie DOS doit être facile à traiter.

Que de détours et de rustines, pour en arriver là !

On comprendra mieux tout le sens de ce que je dis en message N° 88 là :
http://www.developpez.net/forums/d16...professionnel/

Ce genre de "traitement/recensement" n'a que rarement une autre finalité que celle de pupitrage. Un recensement de l'espèce n'est nécessaire que de temps à autre. Le dernier des soucis d'un pupitreur est la forme de l'affichage des données qui l'intéressent. Il s'en moque comme de l'an 14 ! ;)
25/01/2017, 02h24
clementmarcotte

Citation:

Envoyé par informer

Surtout que in fine, tout ça doit être chargé dans access, donc la sortie DOS doit être facile à traiter.

Visiblement que tu puisses faire tout cela intelligemment en une fois en VB.net c'est secondaire.

Visiblement, que VB.net soit capable de piloter Access par automation est secondaire.

Je suppose que c'est la réponse facile que le Service de Dictature informatique ne veut pas. Tu pourras leur dire que les versions Community et Desktop sont gratuites.