Supprimer le point et l'extention de noms de fichiers

[font=Courier New][color=darkblue]Sub[/color] test()
s = "C:\toto.xls"
MsgBox Left(s, Len(s) - 4)
[color=darkblue]End[/color] [color=darkblue]Sub[/color][/font]

Sub TestListFilesInFolder()
Dim RootFolder$

  ' choix du dossier à scanner
  RootFolder = ChoisirDossier
  If RootFolder = "" Then Exit Sub
  
  Sheets("Feuil2").Select

  With Range("A1")
    .Formula = " Contenu du dossier : " & RootFolder
    .Font.Bold = True
    .Font.Size = 12
  End With

  Range("A3").Formula = "Chemin : "
  Range("B3").Formula = "Nom : "
  Range("C3").Formula = "Date Création : "
  Range("D3").Formula = "Date Dernier Accès : "
  Range("E3").Formula = "Date Dernière Modif : "
  
  With Range("A3:E3")
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = True
  End With
  
  ListFilesInFolder RootFolder, True
  
  Columns("A:H").AutoFit

End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' listes les information du dossier choisis

Dim FSO 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim SubFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim r As Long

  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set SourceFolder = FSO.GetFolder(SourceFolderName)
  r = Range("A65536").End(xlUp).Row + 1

  For Each FileItem In SourceFolder.Files
    Cells(r, 1).Formula = FileItem.ParentFolder
    Cells(r, 2).Formula = FileItem.Name
    Cells(r, 3).Formula = FileItem.DateCreated
    Cells(r, 3).NumberFormatLocal = "jj/mm/aa"
    Cells(r, 4).Formula = FileItem.DateLastAccessed
    Cells(r, 5).Formula = FileItem.DateLastModified
    Cells(r, 5).NumberFormatLocal = "jj/mm/aa"
    r = r + 1
  Next FileItem

  If IncludeSubfolders Then
    For Each SubFolder In SourceFolder.SubFolders
      ListFilesInFolder SubFolder.Path, True
    Next SubFolder
  End If

  Set FileItem = Nothing
  Set SourceFolder = Nothing
  Set FSO = Nothing

Extract_Six_Prem_Chiffres
End Sub

Private Function ChoisirDossier()
Dim objShell, objFolder, chemin, SecuriteSlash
                                            
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = _
        objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
    On Error Resume Next
    chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
    If objFolder.Title = "Bureau" Then
        chemin = "C:\Windows\Bureau"
    End If
    If objFolder.Title = "" Then
        chemin = ""
    End If

    SecuriteSlash = InStr(objFolder.Title, ":")

    If SecuriteSlash > 0 Then
        chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
    End If
    ChoisirDossier = chemin
End Function

Cells(r, 2).Formula = FileItem.Name

Cells(r, 2).Formula = Left(FileItem.Name, Len(FileItem.Name) - 4)

For Each FileItem In SourceFolder.Files
Cells(r, 1).Formula = FileItem.ParentFolder
Cells(r, 2).Formula = [COLOR=Blue][B]Left(FileItem.Name, Len(FileItem.Name) - 4)[/B][/COLOR]
Cells(r, 3).Formula = FileItem.DateCreated
Cells(r, 3).NumberFormatLocal = "jj/mm/aa"
Cells(r, 4).Formula = FileItem.DateLastAccessed
Cells(r, 5).Formula = FileItem.DateLastModified
Cells(r, 5).NumberFormatLocal = "jj/mm/aa"
r = r + 1
Next FileItem