Discussion :

[gueulederack]

Bonjour,

Dans un repertoire Modele, je souhaite recherchés tous les fichiers qui commencent par "Referentiel ADEME" pour sélectionner le plus récent. Quel fonction me permet de faire ça ?

Merci d'avance

[gueulederack]

voici ma solution:

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
 
Private Sub InitialiseControl()
 
Dim GestionFichier As Object
Dim sFichier, sTmpt As String
Dim sFichierRecherche As String
Dim ArListFichiersReferent() As String
Dim ArGroupe() As String
Dim ArGroupeSize As Integer
Dim sChemin As String
Dim iVersion As Long
 
Set GestionFichier = CreateObject("Scripting.FileSystemObject")
sChemin = "C:\Users\m.bignon\Documents\ADEME\"
 
 Set AppWrd = CreateObject("Word.Application")
 AppWrd.Visible = False
 
 iVersion = 0
 sFichier = Dir(sChemin & "*.*")
 While sFichier <> ""
    ArListFichiersReferent = Split(sFichier, "_")
    If ArListFichiersReferent(0) = "Referentiel ADEME" Then
    sTmpt = Left(ArListFichiersReferent(1), Len(ArListFichiersReferent(1)) - 5)
      If CLng(sTmpt) > iVersion Then
        sFichierRecherche = "Referentiel ADEME_" & ArListFichiersReferent(1)
      End If
    End If
    sFichier = Dir
 Wend
 
   Set DocWord = AppWrd.Documents.Open(sChemin & sFichierRecherche, Visible:=False)
 
    If ActiveDocument.BuiltInDocumentProperties("Document version") = "" Then
        ActiveDocument.BuiltInDocumentProperties("Document version") = DocWord.BuiltInDocumentProperties("Document version")
    Else
        sFichierRecherche = "Referentiel ADEME_" & ActiveDocument.BuiltInDocumentProperties("Document version") & ".dotm"
        Set DocWord = AppWrd.Documents.Open(sChemin & sFichierRecherche, Visible:=False)
    End If
 
   cbTypeContenu.Clear
   cbCible.Clear
   cbPerimetre.Clear
   cbContributeur.Clear
   cbValideurNom.Clear
   lbThExpertise.Clear
 
   On Error GoTo ErrWrd
 
 
     'Remplir la liste déroulante catégorie du document
     sTmp = Replace(DocWord.Bookmarks("groupe1").Range.Text, Chr(13), ";")
     ArGroupe = Split(sTmp, ";")
     ArGroupeSize = UBound(ArGroupe) - LBound(ArGroupe)
     For i = 0 To ArGroupeSize - 1
       cbTypeContenu.AddItem (ArGroupe(i))
     Next i
 
     'Remplir la liste du thème de l'expertise
     sTmp = Replace(DocWord.Bookmarks("groupe2").Range.Text, Chr(13), ";")
     ArGroupe = Split(sTmp, ";")
     ArGroupeSize = UBound(ArGroupe) - LBound(ArGroupe)
     For i = 0 To ArGroupeSize - 1
       lbThExpertise.AddItem (ArGroupe(i))
     Next i
 
     'Remplir la liste déroulante du périmètre de diffusion
     sTmp = Replace(DocWord.Bookmarks("groupe3").Range.Text, Chr(13), ";")
     ArGroupe = Split(sTmp, ";")
     ArGroupeSize = UBound(ArGroupe) - LBound(ArGroupe)
     For i = 0 To ArGroupeSize - 1
       cbPerimetre.AddItem (ArGroupe(i))
     Next i
 
     'Remplir la liste déroulante de la cible/auditoire
     sTmp = Replace(DocWord.Bookmarks("groupe4").Range.Text, Chr(13), ";")
     ArGroupe = Split(sTmp, ";")
     ArGroupeSize = UBound(ArGroupe) - LBound(ArGroupe)
     For i = 0 To ArGroupeSize - 1
       cbCible.AddItem (ArGroupe(i))
     Next i
 
     'Remplir la liste déroulante du niveau de lecture
     sTmp = Replace(DocWord.Bookmarks("groupe5").Range.Text, Chr(13), ";")
     ArGroupe = Split(sTmp, ";")
     ArGroupeSize = UBound(ArGroupe) - LBound(ArGroupe)
     For i = 0 To ArGroupeSize - 1
       cbNivLect.AddItem (ArGroupe(i))
     Next i
 
    'Par défaut la date de péremption se situe 1 an après la date de validation
    dtFinValidite.Value = DateAdd("yyyy", 1, dtDebutValidite.Value)
    tbNbMois.Text = "12"
 
    RechercheInADUsers
 
    cbContributeur.Value = Environ("UserName")
 
 
 
ErrWrd:
DocWord.Close
Set AppWrd = Nothing
Set GestionFichier = Nothing
 
 
 
End Sub