rechercher les fichiers qui n'ont pas été accedés depuis X jours

Le
Alfred WALLACE
Bonjour à tous !
vivement que le nuage de poussière se dissipe !
(y'en a qui veulent rentrer . moi j'aimerai partir )

Voilà, c'est une question un peut "HS" mais
je ne dispose que de excel et le VBA pour développer
donc. je m'en sert (grâce surtout à tous les gurus de ce groupe!!)

je sais parcourir les répertoires et sous/répertoires à la
recherche de fichiers

J'aimerai connaitre (grâce donc au vba) les fichiers qui n'ont
pas été accedés depuis "x" jours.

Je sais que ce n'est pas "vraiment" du vba pour excel, mais
plutot un problème "systeme"

ceci dit, je suis toujours émerveillé par la puissance du vba
lorsqu'on l'utilise avec des api windows (je ne sais pas si l'on peut
dire çà comme çà).

Enfin, voilà, j'espère ne pas vous avoir trop poluer avec
mes cendres volcaniques matinales !

cordialement
José
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
michdenis
Le #21600951
Bonjour,

Exemple pour lister tous les fichiers du répertoire "C:"
(n'inclut pas les sous-répertoires)
qui n'ont pas été accédé depuis au moins 20 jours.

Il ne reste plus qu'à imbriquer cette commande
Lister_Fichier_Non_Acceder Repertoire, 20
dans ta boucle énumérant chaque répertoire et sous-répertoire
du chemin désiré.

'Variable déclarée dans le haut du module
Dim A As Long

'--------------------------------------
Sub test()
Dim Repertoire As String

A = 0
Repertoire = "c:"
Lister_Fichier_Non_Acceder Repertoire, 20

End Sub

'--------------------------------------
Sub Lister_Fichier_Non_Acceder(Repertoire, NbJours)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set Rep = objFSO.GetFolder(Repertoire)

With Worksheets("Sheet1")
For Each f In Rep.Files
If DateDiff("d", f.DateLastAccessed, Now) > NbJours Then
A = A + 1
.Range("A" & A) = Repertoire & f.Name
End If
Next
End With

Set objFSO = Nothing: Set Rep = Nothing: Set f = Nothing
End Sub
'--------------------------------------


"Alfred WALLACE"
Bonjour à tous !
vivement que le nuage de poussière se dissipe !
(y'en a qui veulent rentrer .... moi j'aimerai partir ...)

Voilà, c'est une question un peut "HS" mais
je ne dispose que de excel et le VBA pour développer
donc.... je m'en sert (grâce surtout à tous les gurus de ce groupe!!)

je sais parcourir les répertoires et sous/répertoires à la
recherche de fichiers...

J'aimerai connaitre (grâce donc au vba) les fichiers qui n'ont
pas été accedés depuis "x" jours.

Je sais que ce n'est pas "vraiment" du vba pour excel, mais
plutot un problème "systeme" ...

ceci dit, je suis toujours émerveillé par la puissance du vba
lorsqu'on l'utilise avec des api windows (je ne sais pas si l'on peut
dire çà comme çà)....

Enfin, voilà, j'espère ne pas vous avoir trop poluer avec
mes cendres volcaniques matinales !

cordialement
José
Michel MTO
Le #21616181
Bonjour MichDenis,
Comment faire pour inclure les sous répertoires ?

merci par avance

Michel MTO

"michdenis" news:
Bonjour,

Exemple pour lister tous les fichiers du répertoire "C:"
(n'inclut pas les sous-répertoires)
qui n'ont pas été accédé depuis au moins 20 jours.

Il ne reste plus qu'à imbriquer cette commande
Lister_Fichier_Non_Acceder Repertoire, 20
dans ta boucle énumérant chaque répertoire et sous-répertoire
du chemin désiré.

'Variable déclarée dans le haut du module
Dim A As Long

'--------------------------------------
Sub test()
Dim Repertoire As String

A = 0
Repertoire = "c:"
Lister_Fichier_Non_Acceder Repertoire, 20

End Sub

'--------------------------------------
Sub Lister_Fichier_Non_Acceder(Repertoire, NbJours)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set Rep = objFSO.GetFolder(Repertoire)

With Worksheets("Sheet1")
For Each f In Rep.Files
If DateDiff("d", f.DateLastAccessed, Now) > NbJours Then
A = A + 1
.Range("A" & A) = Repertoire & f.Name
End If
Next
End With

Set objFSO = Nothing: Set Rep = Nothing: Set f = Nothing
End Sub
'--------------------------------------


"Alfred WALLACE"

discussion :

Bonjour à tous !
vivement que le nuage de poussière se dissipe !
(y'en a qui veulent rentrer .... moi j'aimerai partir ...)

Voilà, c'est une question un peut "HS" mais
je ne dispose que de excel et le VBA pour développer
donc.... je m'en sert (grâce surtout à tous les gurus de ce groupe!!)

je sais parcourir les répertoires et sous/répertoires à la
recherche de fichiers...

J'aimerai connaitre (grâce donc au vba) les fichiers qui n'ont
pas été accedés depuis "x" jours.

Je sais que ce n'est pas "vraiment" du vba pour excel, mais
plutot un problème "systeme" ...

ceci dit, je suis toujours émerveillé par la puissance du vba
lorsqu'on l'utilise avec des api windows (je ne sais pas si l'on peut
dire çà comme çà)....

Enfin, voilà, j'espère ne pas vous avoir trop poluer avec
mes cendres volcaniques matinales !

cordialement
José

michdenis
Le #21616471
Bonjour,

Une méthode en utilisant les API de Windows

Tu copies tout ce qui suit dans un module standard.
Et tu adaptes la valeur de la constante
selon le type de fichiers que tu veux lister.
Exemple : Pour tous les fichiers Excel peu importe la version
Const Masque = "*.xl*"
Pour tous les fichiers sans distinction
Const Masque = "*.*"
Pour les fichiers Word
Const Masque = "*.do*"

'---------------------------------------------
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

'----------------------------------------
Const Masque = "*.xls" 'A définir...

Dim Arr() As String
Dim NbFichiers As Long
Dim FileFindData As WIN32_FIND_DATA
Dim Fichier As String
'--------------------------------------------
Sub Test()
ReDim Arr(1 To 1)
NbFichiers = 0
Recurse "C:UsersDMDocuments"
If NbFichiers > 0 Then
Application.ScreenUpdating = False
With Range("A1").Resize(NbFichiers)
.Value = Application.Transpose(Arr)
.Sort [A1]
.EntireColumn.AutoFit
End With
Else
MsgBox "Aucun fichier ayant cette extension : " & Masque
End If
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 & ""
ElseIf Fichier Like Masque Then
NbFichiers = NbFichiers + 1
ReDim Preserve Arr(1 To NbFichiers)
Arr(NbFichiers) = Fichier
End If
Loop While FindNextFileA(hFindfile, FileFindData)
FindClose hFindfile
End Sub
'--------------------------------------------






"Michel MTO" hqrtou$uq0$
Bonjour MichDenis,
Comment faire pour inclure les sous répertoires ?

merci par avance

Michel MTO

"michdenis" news:
Bonjour,

Exemple pour lister tous les fichiers du répertoire "C:"
(n'inclut pas les sous-répertoires)
qui n'ont pas été accédé depuis au moins 20 jours.

Il ne reste plus qu'à imbriquer cette commande
Lister_Fichier_Non_Acceder Repertoire, 20
dans ta boucle énumérant chaque répertoire et sous-répertoire
du chemin désiré.

'Variable déclarée dans le haut du module
Dim A As Long

'--------------------------------------
Sub test()
Dim Repertoire As String

A = 0
Repertoire = "c:"
Lister_Fichier_Non_Acceder Repertoire, 20

End Sub

'--------------------------------------
Sub Lister_Fichier_Non_Acceder(Repertoire, NbJours)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set Rep = objFSO.GetFolder(Repertoire)

With Worksheets("Sheet1")
For Each f In Rep.Files
If DateDiff("d", f.DateLastAccessed, Now) > NbJours Then
A = A + 1
.Range("A" & A) = Repertoire & f.Name
End If
Next
End With

Set objFSO = Nothing: Set Rep = Nothing: Set f = Nothing
End Sub
'--------------------------------------


"Alfred WALLACE"

discussion :

Bonjour à tous !
vivement que le nuage de poussière se dissipe !
(y'en a qui veulent rentrer .... moi j'aimerai partir ...)

Voilà, c'est une question un peut "HS" mais
je ne dispose que de excel et le VBA pour développer
donc.... je m'en sert (grâce surtout à tous les gurus de ce groupe!!)

je sais parcourir les répertoires et sous/répertoires à la
recherche de fichiers...

J'aimerai connaitre (grâce donc au vba) les fichiers qui n'ont
pas été accedés depuis "x" jours.

Je sais que ce n'est pas "vraiment" du vba pour excel, mais
plutot un problème "systeme" ...

ceci dit, je suis toujours émerveillé par la puissance du vba
lorsqu'on l'utilise avec des api windows (je ne sais pas si l'on peut
dire çà comme çà)....

Enfin, voilà, j'espère ne pas vous avoir trop poluer avec
mes cendres volcaniques matinales !

cordialement
José

Michel MTO
Le #21616771
Merci MichDenis,

çà à l'air bien plus compliqué !!
Je regarde çà de plus près et je reviendrai peut être avec des questions.

Michel MTO
michdenis
Le #21617071
Pour simplifier la tâche, j'ai intégré à la procédure,
la requête initiale du demandeur à savoir, comment lister
les fichiers n'ayant pas été accédés depuis X jours.

Accéder ne signifie pas seulement ouvert, mais aussi ceux
qui ont été déplacés, renommées, ouverts ...

La seule chose qui reste à faire est de définir les 4 constantes
Ce ne devrait pas être trop difficile !

'-------------------------------
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 Arr() As String
Dim NbFichiers As Long
Dim FileFindData As WIN32_FIND_DATA
Dim Fichier As String
Dim objFSO As Object, F As Object

'************Constante à définir*************

Const Masque = "*.xls*" 'Type Extension du fichier
Const NomFeuilleDestination = "Sheet1"
Const Repertoire = "C:UsersDMDocuments"
Const NbJours = 20
'Si la durée sans accès au fichier en jours > Nbjours

'********************************************
'-------------------------------
Sub Test()
If Dir(Repertoire, vbDirectory) <> "" Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
ReDim Arr(1 To 1)
NbFichiers = 0
Recurse Repertoire
If NbFichiers > 0 Then
Application.ScreenUpdating = False
With Worksheets(NomFeuilleDestination)
With .Range("A1").Resize(NbFichiers)
.Value = Application.Transpose(Arr)
.Sort .Item(1, 1)
.EntireColumn.AutoFit
End With
End With
Else
MsgBox "Aucun fichier ayant cette extension : " & Masque
End If
Else
MsgBox "Chemin inexistant " & Repertoire
End If
Set objFSO = Nothing: Set Rep = Nothing: Set F = Nothing
End Sub
'-------------------------------
Private Sub Recurse(ByVal Chemin As String)
Dim hFindfile As Long
hFindfile = FindFirstFileA(Chemin & "*.*", FileFindData)
FindNextFileA hFindfile, FileFindData
If FindNextFileA(hFindfile, FileFindData) = 0 Then
FindClose hFindfile
Exit Sub
End If
Do
Fichier = Chemin & Left$(FileFindData.cFileName, _
InStr(1, FileFindData.cFileName, vbNullChar) - 1)
If GetAttr(Fichier) And vbDirectory Then
Recurse Fichier & ""
ElseIf Fichier Like Masque Then
If Fichier_Non_Acceder(Fichier) = True Then
NbFichiers = NbFichiers + 1
ReDim Preserve Arr(1 To NbFichiers)
Arr(NbFichiers) = Fichier
End If
End If
Loop While FindNextFileA(hFindfile, FileFindData)
FindClose hFindfile
End Sub
'-------------------------------
Function Fichier_Non_Acceder(Fichier As String) As Boolean
Set F = objFSO.GetFile(Fichier)
If DateDiff("d", F.DateLastAccessed, Now) > NbJours Then
Fichier_Non_Acceder = True
End If
End Function
'-------------------------------




"Michel MTO" hqs3m4$804$
Merci MichDenis,

çà à l'air bien plus compliqué !!
Je regarde çà de plus près et je reviendrai peut être avec des questions.

Michel MTO
Alfred WALLACE
Le #21654541
bonjour MichDenis !

je reviens un peu tard ici, pour vous envoyez mes remerciements pour
ces informations toutes plus riches les unes que les autres !

José



On 23 avr, 15:04, "michdenis"
Pour simplifier la tâche, j'ai intégré à la procédure,
la requête initiale du demandeur à savoir, comment lister
les fichiers n'ayant pas été accédés depuis X jours.

Accéder ne signifie pas seulement ouvert, mais aussi ceux
qui ont été déplacés, renommées, ouverts ...

La seule chose qui reste à faire est de définir les 4 constantes
Ce ne devrait pas être trop difficile !

'-------------------------------
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 Lo ng

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 Arr() As String
Dim NbFichiers As Long
Dim FileFindData As WIN32_FIND_DATA
Dim Fichier As String
Dim objFSO As Object, F As Object

'************Constante à définir*************

Const Masque = "*.xls*"  'Type Extension du fichier
Const NomFeuilleDestination = "Sheet1"
Const Repertoire = "C:UsersDMDocuments"
Const NbJours = 20
'Si la durée sans accès au fichier en jours > Nbjours

'********************************************
'-------------------------------
Sub Test()
If Dir(Repertoire, vbDirectory) <> "" Then
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ReDim Arr(1 To 1)
    NbFichiers = 0
    Recurse Repertoire
    If NbFichiers > 0 Then
        Application.ScreenUpdating = False
        With Worksheets(NomFeuilleDestination)
            With .Range("A1").Resize(NbFichiers)
                .Value = Application.Transpose(Arr)
                .Sort .Item(1, 1)
                .EntireColumn.AutoFit
            End With
        End With
    Else
        MsgBox "Aucun fichier ayant cette extension : " & Masque
    End If
Else
    MsgBox "Chemin inexistant " & Repertoire
End If
Set objFSO = Nothing: Set Rep = Nothing: Set F = Nothing
End Sub
'-------------------------------
Private Sub Recurse(ByVal Chemin As String)
Dim hFindfile As Long
hFindfile = FindFirstFileA(Chemin & "*.*", FileFindData)
FindNextFileA hFindfile, FileFindData
If FindNextFileA(hFindfile, FileFindData) = 0 Then
    FindClose hFindfile
    Exit Sub
End If
Do
    Fichier = Chemin & Left$(FileFindData.cFileName, _
        InStr(1, FileFindData.cFileName, vbNullChar) - 1)
    If GetAttr(Fichier) And vbDirectory Then
        Recurse Fichier & ""
    ElseIf Fichier Like Masque Then
       If Fichier_Non_Acceder(Fichier) = True Then
            NbFichiers = NbFichiers + 1
            ReDim Preserve Arr(1 To NbFichiers)
            Arr(NbFichiers) = Fichier
        End If
    End If
Loop While FindNextFileA(hFindfile, FileFindData)
FindClose hFindfile
End Sub
'-------------------------------
Function Fichier_Non_Acceder(Fichier As String) As Boolean
Set F = objFSO.GetFile(Fichier)
If DateDiff("d", F.DateLastAccessed, Now) > NbJours Then
    Fichier_Non_Acceder = True
End If
End Function
'-------------------------------

"Michel MTO" hqs3m4$
Merci MichDenis,

çà à l'air bien plus compliqué !!
Je regarde çà de plus près et je reviendrai peut être avec des qu estions.

Michel MTO
Publicité
Poster une réponse
Anonyme