1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
|
Public Function UnzipTo(ByVal zipFile As String, ByVal unzipPath As String) As Boolean
On Error GoTo catch
Dim oShell As Object, bExist As Boolean, sErr As String
If zipFile <> vbNullString And Right$(zipFile, 1) <> "\" Then bExist = (Dir(zipFile) <> vbNullString)
If Not bExist Then
sErr = "le fichier '" & zipFile & "' est introuvable..."
ElseIf unzipPath <> vbNullString And _
Dir(unzipPath & "\", vbDirectory) <> vbNullString Then
Set oShell = CreateObject("Shell.Application")
oShell.Namespace(CVar(unzipPath)).CopyHere oShell.Namespace(CVar(zipFile)).items
UnzipTo = True
Else
sErr = "Le répertoire '" & unzipPath & "' n'existe pas..."
End If
fin:
If Not oShell Is Nothing Then Set oShell = Nothing
If UnzipTo Then
MsgBox "Décompression réussie du fichier '" & zipFile & _
"' dans le répertoire '" & unzipPath & "'", vbInformation, "UnzipTo"
Else
MsgBox sErr, vbExclamation, "UnzipTo"
End If
Exit Function
catch:
sErr = "Une erreur s'est produite..." & vbCrLf & "Erreur n°" & Err.Number & vbCrLf & "Description" & Err.Description
Resume fin
End Function |
Partager