Open any Email Attachment, functionized
June 8, 2009 • JP • No Comments • Rate This Article
• Links to this article
In the comments for Open Any Email Attachment In Outlook I promised a functionized version of the code from so you can specify the folder where you would like to save the file. So a year later, here it is.
I reused the code from Post Email Data to the Web to encapsulate the function that retrieves the selected or open email message. The GetMessage function will either return a reference to an opened email (it should error if you have multiple emails open) or the first (if you have multiple) selected email in an Explorer view. Otherwise the function is the same; just call it with the name of the folder you want to use to save the attachment. If the folder doesn't exist, it will be created.
' based on code posted by Sue Mosher: http://tinyurl.com/684zg4
' See http://www.codeforexcelandoutlook.com/blog/2008/05/open-any-email-attachment-from-outlook/ for sub procedure
Dim myShell As Object
Dim MyItem As Outlook.MailItem
Dim myAttachments As Outlook.attachments
Dim i As Long
Dim Att As String
' check for valid folder name
If Right$(folderName, 1) <> "\" Then
folderName = folderName & "\"
End If
' create folder if it doesn't exist
If Dir(folderName, vbDirectory) = "" Then
MkDir folderName
End If
Set MyItem = GetMessage
If MyItem Is Nothing Then Exit Sub
Set myAttachments = MyItem.attachments
If myAttachments.Count > 0 Then
For i = 1 To myAttachments.Count
Att = myAttachments.item(i).DisplayName
' delete just in case it exists from before
On Error Resume Next
Kill folderName & Att
On Error GoTo 0
myAttachments.item(i).SaveAsFile folderName & Att
Next i
End If
' Windows Script Host Object
Set myShell = CreateObject("WScript.Shell")
myShell.Run folderName & Att
End Function
Function GetMessage() As Outlook.MailItem
' returns MailItem object reference to open/selected mail item
' from http://www.codeforexcelandoutlook.com/blog/2009/04/post-email-data-to-the-web/
' if any error occurs, just exit
On Error GoTo ExitProc
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set GetMessage = ActiveExplorer.Selection.item(1)
Case "Inspector"
Set GetMessage = ActiveInspector.currentItem
Case Else
End Select
ExitProc:
End Function
Usage:
Call OpenAttachmentInNativeApp("C:\MyFiles")
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: Miscellaneous Access VBA Macros
Next Post: Apply Range Names to your worksheet
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].