Saving compressed attachments in Windows 7/Outlook 2003
March 26, 2010 • JP • No Comments • Rate This Article
• Links to this article
If you upgrade to Windows 7 and continue to use Outlook 2003, you might want to read Tip 700: Outlook 2003, Win7, and zip attachments by Diane Poremsky, which states:
With Outlook 2003 on Windows 7, users can't open zip attachments from a message – double clicking on the zip brings up the open/save dialog but clicking Open does not open it (the zip is saved in the securetemp folder each time its double clicked).
Thanks, Microsoft! Any reason why zip files get special treatment? They can't be executed like VBScript (.vbs), Executables (.exe) and so on, just by clicking on them. But I digress.
To open .Zip files that are sent to you as attachments, then, you'll need to save them to the hard drive and then uncompress them using whatever tool you usually use. Let's explore a few ways to do this, as well as how to uncompress .RAR archives.
I'd like to acknowledge Ron de Bruin's site, from which some of the code on this page was inspired and based: Unzip file or files with the default Windows zip program (VBA). Don't be fooled by the URL — Ron told me that his code works in Windows 7 and Vista as well. I verified that it works with Vista.
Save attachments
We'll start by saving ZIP and RAR file attachments. We can do this in two ways: as an event handler, or as a procedure that can be run on demand. Then we'll explore how to update the code to actually decompress the archives.
Event Handler
The following code, placed in ThisOutlookSession module, will save all incoming archive attachments to a folder on your hard drive. Currently it supports both ZIP and RAR, but you can add more types as needed. I arbitrarily chose a folder to save the files; to find the location of the save folder, open any of the VBA IDEs (Outlook, Access, Excel etc) and paste the following into the Immediate Window (Ctrl+G):
This will tell you where the files will be saved (if you don't edit the code). Of course, you can change this to put the archives anywhere you want; for example, a network share. The folder will be created if it doesn't exist.
Note that I didn't use "C:\" as my usual folder of choice, because this post is specifically about working with Windows 7, which won't let you write to the root folder. Neither does Vista, and Windows 7 is (IMHO) just Vista with a few extra features. You still get Vista's annoying security prompts (you have to confirm that you want to start Windows Defender!). Sorry, I'm digressing again. Here's the code:
Private Sub Application_Startup()
Set Items = GetItems(GetNS(GetOutlookApp), olFolderInbox)
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim saveFolder As String
Dim saveFolderExists As Boolean
Dim Msg As Outlook.MailItem
Dim MsgAttachs As Outlook.Attachments
Dim MsgAttach As Outlook.Attachment
Dim attachFileName As String
If Not IsMail(item) Then GoTo ProgramExit
Set Msg = item
Set MsgAttachs = Msg.Attachments
If MsgAttachs.Count > 0 Then
For Each MsgAttach In MsgAttachs
attachFileName = MsgAttach.FileName
If IsArchive(attachFileName) Then
' check for save folder, create it if necessary
' edit the line immediately below if you want to use a different folder
saveFolder = Environ("USERPROFILE") & "\Email Archives\"
saveFolderExists = FileFolderExists(saveFolder)
If Not saveFolderExists Then
MkDir saveFolder
End If
MsgAttach.SaveAsFile saveFolder & attachFileName
' this is where we'll add code to open each archive
End If
Next MsgAttach
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.number & " - " & Err.Description
Resume ProgramExit
End Sub
Function GetItems(olNS As Outlook.NameSpace, _
folder As OlDefaultFolders) As Outlook.Items
Set GetItems = olNS.GetDefaultFolder(folder).Items
End Function
Function GetOutlookApp() As Outlook.Application
' returns reference to native Application object
Set GetOutlookApp = Outlook.Application
End Function
Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
Set GetNS = app.GetNamespace("MAPI")
End Function
Function IsMail(itm As Object) As Boolean
IsMail = (TypeName(itm) = "MailItem")
End Function
Function IsArchive(attachFileName As String) As Boolean
Dim archiveTypes() As Variant
Dim fileExt As String
archiveTypes = Array("ZIP","RAR")
' get file extension
fileExt = GetFileType(attachFileName)
If UBound(Filter(archiveTypes, fileExt)) > -1 Then
IsArchive = True
End If
End Function
Function GetFileType(ByVal fileName As String) As String
' get file extension
GetFileType = Mid$(fileName, InStrRev(fileName, ".") + 1, Len(fileName))
End Function
Public Function FileFolderExists(strFullPath As String) As Boolean
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: Check if a file or folder exists
On Error GoTo EarlyExit
If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
EarlyExit:
On Error GoTo 0
End Function
The code block above includes several procedures you should be familiar with (if you read this blog regularly): GetItems, GetOutlookApp, GetNS and IsMail. I've also included a few new ones. FileFolderExists was taken from a Ken Puls article. IsArchive is based on code found at Utility Functions for use with Outlook 2003 VBA.
On-demand Procedure
For a procedure that saves all attachments from a folder, see Save all attachments from selected folder, continued.
Open Archives
Now let's figure out how to open ZIP and RAR files. This is where Ron's code comes in.
The following function will take a filename (with full path) and destination folder. The archive file will be opened into that folder. If no folder is specified, the archive is opened into the folder where the archive is located (i.e. the same folder).
' takes ZIP or RAR archives
' based on http://www.rondebruin.nl/windowsxpunzip.htm
Dim FSO As Object
Dim oApp As Object
Dim DefPath As String
Dim FileNameFolder As Variant
Const pathSep As String = "\"
' if destination folder not specified,
' use filename folder
If IsMissing(folderName) Then
DefPath = FilePath(CStr(Fname))
Else
DefPath = folderName
If Right(DefPath, 1) <> pathSep Then
DefPath = DefPath & pathSep
End If
End If
FileNameFolder = DefPath
'Make the normal folder in DefPath
If Len(Dir(DefPath, vbDirectory)) = 0 Then
MkDir DefPath
End If
Select Case UCase$(Right(Fname, 3))
Case "ZIP"
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).Items
Case "RAR"
' http://www.rarlab.com/rar_add.htm
Shell "c:\program files\unrar\unrar e -y" & Fname & " " & FileNameFolder, _
vbHide
End Select
End Function
' http://www.vbaexpress.com/kb/getarticle.php?kb_id=767
' the following function will get the path only (i.e. the folder)
' from the file's full path:
Function FilePath(strPath As String) As String
FilePath = Left$(strPath, InStrRev(strPath, "\"))
End Function
Sample usage
Call OpenArchive("C:\Users\Jimmy Pena\Desktop\MyFile.zip", _
"C:\Users\Jimmy Pena\Desktop\My Files\")
End Sub
The Newly Updated Code
Now we'll incorporate the archive-opening function OpenArchive into the original event handler. Note that this code will now automatically decompress any ZIP or RAR files you receive.
Private Sub Application_Startup()
Set Items = GetItems(GetNS(GetOutlookApp), olFolderInbox)
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim saveFolder As String
Dim saveFolderExists As Boolean
Dim Msg As Outlook.MailItem
Dim MsgAttachs As Outlook.Attachments
Dim MsgAttach As Outlook.Attachment
Dim attachFileName As String
If Not IsMail(item) Then GoTo ProgramExit
Set Msg = item
Set MsgAttachs = Msg.Attachments
If MsgAttachs.Count > 0 Then
For Each MsgAttach In MsgAttachs
attachFileName = MsgAttach.FileName
If IsArchive(attachFileName) Then
' check for save folder, create it if necessary
' edit the line immediately below if you want to use a different folder
saveFolder = Environ("USERPROFILE") & "\Email Archives\"
saveFolderExists = FileFolderExists(saveFolder)
If Not saveFolderExists Then
MkDir saveFolder
End If
MsgAttach.SaveAsFile saveFolder & attachFileName
OpenArchive(saveFolder & attachFileName)
End If
Next MsgAttach
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.number & " - " & Err.Description
Resume ProgramExit
End Sub
Outlook ·
Rate This Article:
(No Ratings Yet)
Loading ...What now?
Subscribe To The Blog
Email This Article
Follow Me On Twitter
My Facebook Page
Or just keep reading:
I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space if you want to learn more about VBA. Keep Reading »
Previous Post: Interview with Rod Stephens and a book giveaway
Next Post: Another contest is in the "books"
Speak Your Mind
Tell us what you're thinking...Certain comments (including first-time comments) are subject to moderation and will not appear immediately. Please view the Comment Policy for more information. To post VBA code in your comment, use tags like this: [cc lang='vb']Code goes here[/cc].