Sélection de fichiers dans un répertoire

[Céline67]

Bonjour à tous,

J'ai cette fonction qui recupere tous les fichiers d'un répertoire avec un préfixe définit:

"
Public nwbk As Workbook
Public awbk As Workbook

Public Function listeFichiers()
Dim RepFilePointRevue As String
Dim Liste As Variant
Dim prefix As String, cpath As String

Set awbk = Application.ActiveWorkbook
Set nwbk = Application.Workbooks.Add

prefix = "Point Revue-projet-DQI_"
cpath = awbk.Path & "\"
RepFilePointRevue = cpath & prefix & "*"

Liste = GetFileList(RepFilePointRevue)
End Function
"
et
"
Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec. ' if no matching files are found, it returns false
Dim Filecount As Integer
Dim Filename As String

'On Error Goto NoFilesFound Filecount = 0
Filename = Dir(FileSpec)
If Filename = "" Then GoTo NoFilesFound

' loop until no more matching files are found
Do While Filename <> ""
Filecount = Filecount + 1
ReDim Preserve Filearray(1 To Filecount)
Filearray(Filecount) = Filename
Filename = Dir()
Loop
GetFileList = Filearray
Exit Function ' Error handler
NoFilesFound:
GetFileList = False
End Function
"
--------------------------------------------------------
Voici un listing des fichiers ramenés par ces fonctions présents dans Liste:
Point Revue-projet-DQI_AF_2006_10_30.xls
Point Revue-projet-DQI_AF_2006_11_06.xls
Point Revue-projet-DQI_JH_2006_11_06.xls
Point Revue-projet-DQI_TF_2006_10_30.xls
Point Revue-projet-DQI_TF_2006_11_06.xls
Point Revue-projet-DQI_Synthèse_2006_11_06.xls
-----------------------------------------------------------

1er point:
Comment faire pour ne pas sélectionner les fichiers contenant le mot "Synthèse"?

2ème point:
Les 2 lettres qui suivent "Point Revue-projet-DQI_" (AF, JH, TF ...) correspondent à des personnes.
Je souhaiterai que pour chaque personne, ne garder que le fichier le plus récent donc pour AF n'avoir dans Liste que Point Revue-projet-DQI_AF_2006_11_06.xls
et donc je souhaiterais que Liste ne contienne que:
Point Revue-projet-DQI_AF_2006_11_06.xls
Point Revue-projet-DQI_JH_2006_11_06.xls
Point Revue-projet-DQI_TF_2006_11_06.xls


Comment faire????

Merci de votre aide

 

[Hervé]

Re : Sélection de fichiers dans un répertoire

bonjour

je suis parti du tableau liste qui contient l'ensemble de tes fichiers.

je renvoi le nouveau tableau liste sur la feuille directement depuis la function, à toi d'adapter à ton cas précis

Accroche toi c'est du lourd, proche de l'usine à gaz :

Public Function listeFichiers()
Dim RepFilePointRevue As String
Dim Liste As Variant
Dim prefix As String, cpath As String
Dim tablo()
Dim tablodate, element
Dim data As New Collection
Dim max As Date
Dim ligne As Integer
Dim i As Integer

Set awbk = Application.ActiveWorkbook
Set nwbk = Application.Workbooks.Add

prefix = "Point Revue-projet-DQI_"
cpath = awbk.Path & "\"
RepFilePointRevue = cpath & prefix & "*"

Liste = GetFileList(RepFilePointRevue)

ReDim tablo(1 To UBound(Liste, 1), 1 To 3)

'on exclut les synthèse
For i = 1 To UBound(Liste)
    If InStr(1, Liste(i), "Synthèse") = 0 Then
        tablo(i, 1) = Liste(i)
    End If
Next i


For i = 1 To UBound(tablo)
    If tablo(i, 1) <> "" Then
    'on met en forme les dates
        tablo(i, 2) = Split(tablo(i, 1), ".")(0)
        tablo(i, 2) = Mid(tablo(i, 2), Len(tablo(i, 2)) - 9)
        tablodate = Split(tablo(i, 2), "_")
        tablo(i, 2) = DateSerial(tablodate(0), tablodate(1), tablodate(2))
     'on recherche les "AF" sans doublons
        On Error Resume Next
        data.Add Split(tablo(i, 1), "_")(1), CStr(Split(tablo(i, 1), "_")(1))
        On Error GoTo 0
    End If
Next i

For Each element In data
    For i = 1 To UBound(tablo)
        If tablo(i, 1) <> "" Then
            If Split(tablo(i, 1), "_")(1) = element Then
                If tablo(i, 2) > max Then
                    max = tablo(i, 2)
                    ligne = i
                End If
            End If
        End If
    Next i
    tablo(ligne, 3) = "top"
    max = "01/01/1900"
    ligne = 0
Next element

For i = 1 To UBound(tablo)
    If tablo(i, 1) <> "" Then
        If tablo(i, 3) = "top" Then
            ligne = ligne + 1
            Cells(ligne, 1) = tablo(i, 1)
        End If
    End If
Next i
End Function

salut

 

[Céline67]

Re : Sélection de fichiers dans un répertoire

bon j'ai pas du tout tout compris dans ton code mais il m'a bien aidé:
voila ce que j'ai fait:

ReDim tablo(0 To UBound(Liste))
j = 0

'on exclut les synthèse
For i = LBound(Liste) To UBound(Liste)
If InStr(1, Liste(i), "_Syn") = 0 Then
tablo(j) = Liste(i)
j = j + 1
End If
Next i

'on exclut les doublons pour chaque personne

Files(0) = tablo(0)
i = 0
j = 0
For i = LBound(tablo) To UBound(tablo)
If Mid(tablo(i), 1, 26) = Mid(Files(j), 1, 26) Then
Files(j) = tablo(i)
Else
Files(j + 1) = tablo(i)
j = j + 1
End If
Next i

le "Dir" sur le répertoire ramene les fichiers par ordre alphabétique donc pas besoin de changer la forme de la date.

Merci encore car je n'étais pas du tout partie dans cette direction ...