Function Get_Extensions(Dossier)
Const adChar = 129, adInteger = 3
Dim Fichier As Variant
Dim Ext As String, Fso As Object, RS As Object
Set RS = CreateObject("ADODB.Recordset")
RS.Fields.Append "Ext", adChar, 5
RS.Fields.Append "NB", adChar, 10
RS.Open
Set Fso = CreateObject("Scripting.FileSystemObject")
For Each Fichier In Fso.GetFolder(Dossier).Files
Ext = Fso.GetExtensionName(Fichier)
RS.Filter = "EXT='." & UCase(Left(Ext, 4)) & "'"
If RS.EOF Then RS.AddNew
RS("EXT") = "." & UCase(Left(Ext, 4))
RS("NB") = RS("NB") + 1
RS.Update
RS.Filter = ""
RS.MoveFirst
Next
While Not RS.EOF
RS("NB") = "(" & Trim(RS("NB")) & ")"
RS.Update
RS.MoveNext
Wend
If RS.EOF <> RS.BOF Then RS.MoveFirst
RS.Sort = "ext" ' tri de la table
Get_Extensions = Application.Transpose(RS.GetRows)
RS.Close
Set RS = Nothing
Set Fso = Nothing
End Function
Sub test()
Dim TBL
TBL = Get_Extensions("C:\Myrep")
End Sub