récupérer unité et répertoire courant

Chemin = Workbooks("NomDuFichier.xls").path
RepCourant = Curdir
Chdrive "L" 'change le lecteur
Chdir "E:\UnRep 'place dans le répertoire E:\UnRep si E est le lecteur actif

Sub Sauvegarde_Sur_LecteurAmovible()
    Dim FSO As Object
    Dim Drv As Object
    
    'Correspond au nom que vous avez préalablement attribué à votre clé.
    Const Cible As String = "MaCle"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    For Each Drv In FSO.Drives
        If Drv.DriveType = 1 Then
            If Drv.VolumeName = UCase(Cible) And Drv.IsReady Then
                ThisWorkbook.SaveAs Drv.DriveLetter & ":\Nom classeur.xls" ', xlWorkbook '(pour xl2007)
                Exit Sub
            End If
        End If
    Next
    
    MsgBox "Enregistrement non effectué." & vbCrLf & _
        "Le lecteur amovible '" & Cible & "' n'a pas été trouvé."
End Sub

     On error resume next
      ChDrive "Z"
     if err then msgbox "ce lecteur n'existe pas"

chDrive LeDrive

Sub Sauvegarde_Sur_LecteurAmovible()
    Dim FSO As Object
    Dim Drv As Object
    Dim NomCle As String
    'Correspond au nom que vous avez préalablement attribué à votre clé.
    Const Cible As String = "MaClé"
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    For Each Drv In FSO.Drives
        If Drv.DriveType = 1 Then
           NomCle = Drv.VolumeName
             If NomCle = UCase(Cible) And Drv.IsReady Then
                  ThisWorkbook.SaveCopyAs Filename:=Drv.DriveLetter & ":\Nom classeur.xls" ', xlWorkbook '(pour xl2007)
                  Exit Sub
             End If
        End If
    Next
    
    MsgBox "Enregistrement non effectué." & vbCrLf & _
           "Le lecteur amovible '" & Cible & "' n'a pas été trouvé."
End Sub

Sub Lexteur()
Dim i, Driv
    For i = 77 To 66 Step -1
        On Error Resume Next
        ChDrive Chr(i)
        DoEvents
        If Not Err Then
            On Error GoTo 0
            Driv = Split(CurDir, "\")(0)
            If USB(Driv) Then Exit Sub
        End If
    Next
End Sub

Function USB(Driv) As Boolean
    Dim fs, d, s, t
    Application.DisplayAlerts = False 'évite le message si existe déjà
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(Driv)
    If d.DriveType = 1 Then
        ActiveWorkbook.SaveAs Filename:=Driv & "\" & "Essai.xls" '"\APON\le jour j\" & vava & ".xls", FileFormat:= _
xlExcel9795, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
        USB = True
    End If
    Set fs = Nothing
    Set d = Nothing
End Function