'[URL unfurl="true"]http://www.rondebruin.nl/files/windowsxpunzip.txt[/URL]
Sub Unzip1()
Dim FSO As Object
Dim oApp As Object
Dim fname
Dim FileNameFolder
Dim DefPath As String
Dim strDate As String
fname = CurrentProject.path & "\Tek-Tips.zip"
If fname = False Then
'do nothing
Else
'Set default path to current database folder
DefPath = CurrentProject.path
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
'Create normal folder
MkDir FileNameFolder
Set oApp = CreateObject("Shell.Application")
'Copy the files in the newly created folder
oApp.NameSpace(FileNameFolder).CopyHere oApp.NameSpace(fname).Items
MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
End If
End Sub