Unzipping Outlook 2007 attachments with WinXP's unzipper 1

[PPettit]

Every week I get an email (via Outlook 2007) with a zipped file attached to it. I need to know how to unzip the file attached to the currently open message and put the contents in a fixed folder.

Can someone point me to a way to do this with XP's built-in unzipping function? So far, everything I've found demonstrates how to do this with either WinZip or a pre-built (usually commercial) add-in. I would prefer not to use either one of these methods.

 

[WinblowsME]

I stole the following code from one of the pros here (CMP, I think). I'm not sure how it behaves in Outlook 2007.

Sub Unzip_It()
   Dim extract_path As Variant, zip_file As Variant

   extract_path = "C:\Documents and Settings\[COLOR=red]admin[/color]\Desktop\Temp"
   zip_file = "C:\Documents and Settings\[COLOR=red]admin[/color]\Desktop\Temp.zip"
   
   Call Unzip_It_Real_Good(extract_path, zip_file)
End Sub

Private Sub Unzip_It_Real_Good(extract_path As Variant, zip_file As Variant)
   Dim obj_app As Object
   
   ' If you want to extract only one file you can use this:
   ' obj_app.Namespace(extract_path).CopyHere obj_app.Namespace(zip_file).items.Item("test.txt")
   
   Set obj_app = CreateObject("Shell.Application")
   obj_app.NameSpace(extract_path).CopyHere obj_app.NameSpace(zip_file).Items

   Set obj_app = Nothing
End Sub

 

[PPettit]

I'm sure there's a more elegant solution, but this is what I've managed to come up with so far. I think my biggest problem was not realizing that I needed to save the zipped file somewhere else before trying to work with it.

Here are the basic steps:
1. Check if the file is a .ZIP file.
2. Save the zipped file to the C:\TEMP directory.
3. Unzip it to the current user's desktop.
4. Delete the zipped file from C:\TEMP directory.

Sub ExtractZippedFiles()
    Dim myOlApp As Outlook.Application
    Dim myInspector As Outlook.Inspector
    Dim myItem As Outlook.MailItem
    Dim myAttachments As Outlook.Attachments
    Set myOlApp = CreateObject("Outlook.Application")
    Set myInspector = myOlApp.ActiveInspector
    If Not TypeName(myInspector) = "Nothing" Then
        If TypeName(myInspector.CurrentItem) = "MailItem" Then
            Set myItem = myInspector.CurrentItem
            Set myAttachments = myItem.Attachments
            Dim myFilename As Variant
            myFilename = myAttachments.Item(1).FileName
            If Right(myFilename, 4) = ".zip" Then
                myAttachments.Item(1).SaveAsFile "C:\Temp\" & myAttachments.Item(1).DisplayName
                Call Unzip_It(myFilename)
             Else
             End If
        Else
        End If
    End If
End Sub

Private Sub Unzip_It(myFilename As Variant)
   Dim extract_path As Variant, zip_file As Variant
   extract_path = Environ("USERPROFILE") & "\Desktop"
   zip_file = "C:\Temp\" & myFilename
   Call Unzip_It_Real_Good(extract_path, zip_file)
   Kill zip_file
End Sub

Private Sub Unzip_It_Real_Good(extract_path As Variant, zip_file As Variant)
   Dim obj_app As Object
   
   ' If you want to extract only one file you can use this:
   ' obj_app.Namespace(extract_path).CopyHere obj_app.Namespace(zip_file).items.Item("test.txt")
   
   Set obj_app = CreateObject("Shell.Application")
   obj_app.NameSpace(extract_path).CopyHere obj_app.NameSpace(zip_file).Items
   Set obj_app = Nothing
End Sub