ouvrir ici, enregistrer sous là...

Bonjour,
Je sens que j'y suis presque, mais pas encore...
En fait ça bloque dans ma macro "EnregistrerSous" à la ligne contenant
"Set dossier = fso.GetFolder(Depart)" (4ème ligne).
...et je ne sais pas pourquoi !!! (mais vous surement si ! :-)
Une deuxième chose qui va me bloquer (je le sens) c'est que je voudrais
récupérer le nom des fichiers et leur enlever l'extension ".xls" pour les
enregistrer avec l'extension ".csv". Ce que j'ai difficilement réussi à
faire, c'est d'enregistrer-sous des fichiers "NomFichier.xls" en
"NomFichier.xls.csv" ce qui, vous en serez d'accord, n'est pas du meilleur
effet.
Question. Comment faire pour virer l'extension ".xls" de mon nom de
fichier pour avoir un résultat "propre".
Merci

Angel

PS Je n'hésite pas à vous filer la totale desfois que quelque chose
d'autre ne m'ait échappé...

Public Depart$, Destination$
'--------------------------------------------
'ouvre une série de fichiers (.xls) contenus
'dans un répertoire de départ et les
'enregistre au format csv avec la nouvelle
'extension (.csv) dans un répertoire de destination
'--------------------------------------------
Sub ChangeExtensionFichiers()
Dim Depart$, Destination$

' choix dossier de départ - boîte de dialogue -
Depart = ChoisirDossierDepart
If Depart = "" Then Exit Sub

' choix dossier de destination
Destination = ChoisirDossierDestination 'boite de dialogue pour choisir
le dossier destination
If Destination = "" Then Exit Sub

EnregistrerSous

End Sub
Private Function ChoisirDossierDepart()
Dim objShell, objFolder, chemin, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Choisissez le répertoire de
départ", &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
ChoisirDossierDepart = chemin
End Function
Private Function ChoisirDossierDestination()
Dim objShell, objFolder, chemin, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Choisissez le répertoire de
destination", &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
ChoisirDossierDestination = chemin
End Function
'--------------------------------------------------------
' enregistrer_sous
' Récupère le dossier dans lequel se trouvent les fichiers à
' renommer(chemin dans variable publique "Depart")
' Les "enregistre sous" dans le dossier de destination au
' format csv (chemin dans variable publique "Destination")
'--------------------------------------------------------
Sub EnregistrerSous()
Dim fso As Object, dossier As Object, fich As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier = fso.GetFolder(Depart)

'examen du dossier de départ
For Each fich In dossier.Files
If fso.GetExtensionName(fich.Path) = ".xls" Then
ChDir Depart
Workbooks.Open Filename:=Depart & fich
ActiveWorkbook.SaveAs Filename:=Destination & fich & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWindow.Close
End If
Next
End Sub