Directory d'un cd sous excel

Bonjour,voila mon probleme ,j'ai créé un userform qui me permet de prendre le directory d'un cd ou tout autre support et m'enregistre le nom sur une feuil pour apres etre utilisé dans une bd cela fonctionne tres bien a un point pres c'est qu'il recupere les noms mais aussi l'extension et je ne trouve pas comment empecher qu'il prend l'extension
si quelqu'un pouvait m'aider a ce sujet cela serai super genial merci
voici mon code pour vous eclairer


Private Sub Choixdossier2_Click()
Sheets("feuil3").Activate
racine = Choixdossier() ' ou un répertoire C:\xxx e.g.
If racine = "" Then Exit Sub
Range("A:E").Clear
Range("A3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine, 1
Range("A1").Select
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
ActiveCell.Value = decal(niveau - 1) & dossier.Name & "[" & dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
Lit_dossier d, niveau + 1
Next
For Each f In dossier.Files
nom_fich = f.Name
ActiveCell = decal(niveau) & f.Name

ActiveCell.Interior.ColorIndex = 2
ActiveCell.Offset(1, 0).Select
Next
End Sub
Function decal(niv)
decal = String(1 * niv, " ")
End Function
Function Choixdossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & "\"
.Show
If .SelectedItems.Count > 0 Then
Choixdossier = .SelectedItems(1)
Else
Choixdossier = ""
End If
End With
Else
Choixdossier = InputBox("Répertoire?")
End If
End Function