Discussion :

[Denis_67]

Bonjour,

Ca y est on vient de me migrer en 2007 !
Je n'ai plus que 10 and de retard economie, economie !

Bref il me faut valider maintenant les macros que j'ai mise à disposition de mes utilisateurs avant qu'ils ne soient tous migrés !

J'utilise en autre la fonction Filesearch pour retoruver le dernier fichier créé et supprimer les plus anciens or catte fonction n'est plus active.
J'ai regardé le tuto the Silkyroad, mais outre le fait de n'être par sûr d'avoir tout compris, il est embêtant de devoir ajouter un module complémentaires à tous les utilisateurs potentiels.
http://silkyroad.developpez.com/vba/classefilesearch/

Existe-t-il une autre alternative pour faire ce que je veux faire ?
MErci pour vos conseils
Denis.

Voici le code que j'ai récupéré et mis à ma sauce.
Désolé je n'ai plus l'auteur des lignes d'origine.

Le code lit le répertoire et stocke temporairement les fichiers
puis suite à un tri ouvre le plus récent.

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
Set fso = CreateObject("Scripting.FileSystemObject")
Set fs = Application.FileSearch
With fs
.LookIn = "S:\Mon_repertoire"
.Filename = "*.txt"
    .Execute
    For Each f In .FoundFiles
      Set file = fso.GetFile(f)
   If Left(file.Name, 7) = "STK_PSO" Then
      Range("a1") = file.DateLastModified
      Range("b1") = f
      Range("c1") = file.Name
      Range("d1").FormulaR1C1 = "=DATEDIF(RC[-3],NOW(),""md"")"
      Range("a1").Insert Shift:=xlDown
      Range("b1").Insert Shift:=xlDown
      Range("c1").Insert Shift:=xlDown
      Range("d1").Insert Shift:=xlDown
' les fichiers de plus de huit jours sont supprimés
      If Range("d2") > 8 Then
      a_supp = Range("b2").Value
      Kill a_supp
      End If
   End If
   Next f
 
  End With
  Set fso = Nothing
  Set file = Nothing
  Range("A1").Delete Shift:=xlUp
  Range("b1").Delete Shift:=xlUp
  Range("C1").Delete Shift:=xlUp
  Range("D1").Delete Shift:=xlUp
  Range(Range("a1"), Range("a1").End(xlDown)).Select
  Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlNo, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
          DataOption1:=xlSortNormal
  DATE_SAP = Range("a1").Value
  plus_recent = Range("b1").Value
  SAP_FILE = Range("C1").Value
 
If SAP_FILE = "" Then
MsgBox "Pas de fichier de stock disponible relancer plus tard"
End
End If

[parmi]

Bonjour,

Tu pourrais regarder du côté de Dir ainsi que FileDateTime

[Denis_67]

Grâce aux tutos et quelques tests en tatonnant, j'ai réussi à m'en sortir come cela.
Inutile d'activer le complément Microsoft Scripting pour mon application.

J'ai juste repris et adapté le code proposé par Silkyroad
http://excel.developpez.com/faq/?page=FichiersDir

Par contre, je n'ai pas réussi à calculer l'âge de mon fichier en faisant
Age= date - datecrefich, je n'ai pas réussi à rendre le format de Age compatibles pour le calcul !

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
 
Application.ScreenUpdating = False
'********************************************************
'     Recherche des fichiers disponibles suppression des plus vieux que 8 jours 
'     et chargement du plus récent.
'********************************************************
    Dim Fichier As String, Chemin As String
    Dim Tableau()
    Dim m As Integer, i As Integer
    Dim z As Byte, Valeur As Byte
    Dim Datelimite As Date
    Dim Datecrefich As Date
 
'---liste les fichiers du répertoire ---
    Chemin = "MonRépertoire"
    Fichier = Dir(Chemin & "*.*")
    'pour filtrer sur un type de fichiers (par exemple xls)
    'Fichier = Dir(Chemin & "\*.xls")
 
    'Boucle sur les fichiers
    Do
 
        m = m + 1
        ReDim Preserve Tableau(1 To 2, 1 To m)
        Tableau(1, m) = Fichier
 
       Set Fso = CreateObject("Scripting.FileSystemObject")
       Set FileItem = Fso.GetFile(Chemin & "\" & Fichier)
 
        'Récupère la date de création
        Tableau(2, m) = Left(FileItem.DateCreated, 10)
' ici je fixe ma durée d'archive que je souhaite garder (ici 8 jours).
        Datelimite = Date - 8
        Datecrefich = Left(FileItem.DateCreated, 10)
' si le fichier est plus vieux, je le supprime
        If Datelimite > Datecrefich Then
        Kill FileItem
        End If
         Fichier = Dir
    Loop Until Fichier = ""
 
 
    '---Trie les fichiers par ordre décroissant de création ---
    Do
        Valeur = 0
        For i = 1 To m - 1
            If CDate(Tableau(2, i)) < CDate(Tableau(2, i + 1)) Then
                For z = 1 To 2
                    Cible = Tableau(z, i)
                    Tableau(z, i) = Tableau(z, i + 1)
                    Tableau(z, i + 1) = Cible
                Next z
 
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
 
 MonFichierA_Ouvrir = chemin &Tableau(1, 1)