Extraction de fichier sur excel

Sub TestRun()
'Sources : http://excelexperts.com/Unzip-Files-using-VBA
    Call UnZip("C:\toto\Bureau", "MesFichiersDézippés", "C:\toto\Bureau\MonFichier.zip")
End Sub

Sub UnZip(strTargetPath As String, Dossier As String, Fname As Variant)
    Dim oApp As Object
    Dim FileNameFolder As Variant
    If Right(strTargetPath, 1) <> Application.PathSeparator Then
        strTargetPath = strTargetPath & Application.PathSeparator
    End If
    If Not (RepertoireExiste(strTargetPath & Dossier)) Then
        MkDir (strTargetPath & Dossier)
    Else
        MsgBox "Le répertoire : " & Chr(10) & Chr(10) & strTargetPath & Dossier & Chr(10) & Chr(10) & _
        "existe déjà. Merci de le supprimer."
        Exit Sub
    End If
    FileNameFolder = strTargetPath & Dossier
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
End Sub

Function RepertoireExiste(Chemin As String) As Boolean
On Error Resume Next
RepertoireExiste = GetAttr(Chemin) And vbDirectory
End Function