Manufacturing Information Solutions Forum Index Manufacturing Information Solutions
Your Place for Support and Discussions
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Save Embedded Pictures in Their Original Format

 
Post new topic   Reply to topic    Manufacturing Information Solutions Forum Index -> Microsoft
View previous topic :: View next topic  
Author Message
mistux
Site Admin


Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA

PostPosted: Wed Apr 07, 2010 3:36 pm    Post subject: Save Embedded Pictures in Their Original Format Reply with quote

This came from a very good website on Outlook!
Source: http://www.howto-outlook.com/howto/saveembeddedpictures.htm


You’ve probably come across this at least once; You receive a nicely HTML formatted message with embedded pictures so the sender can tell the story with the pictures and when you try to save the pictures you can only save them as a bmp-file. Or; you receive a fun e-mail with an animated gif-file and when you try to save it you can only save or copy it as a bmp-file which will of course break the animation.

This How To article explains how you can save the embedded pictures in their original file format.


•Make sure the Visual Basic editor is installed
•Create macro
•Create a button for the macro
•Using the macro
Make sure the Visual Basic editor is installed
Since we are going to create a macro from code you must have the Visual Basic editor installed (which is the default). If you don’t have it installed you can install it by Control Panel-> Add/Remove Programs-> select your Office version-> button change. Now setup will start. Here you choose for Add or Remove Features-> Select "Choose advanced customization of applications" (Outlook 2003). In the list you get expand Microsoft Office-> Office Shared Features-> Visual Basic for Applications and set it to Run form My Computer. Press "Update" to install. You might need to insert your CD during setup.

Create Macro
As I already provide you with the code, creating the macro is easy. The code has been tested with Outlook 2003 on Windows XP and Outlook 2007 on Windows Vista but should work on previous versions as well.

We start up the Visual Basic Editor by going to Tools-> Macro-> Visual Basic Editor. This will open a new screen. Choose Insert-> Module to create a new module dedicated to this macro. Select the newly created module in the left pane and rename it to "SaveAttachments" by changing the Properties value in the pane underneath. Copy and paste the code below to the module.

Code:

Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260


Function BrowseFolder(Optional Caption As String, _
    Optional InitialFolder As String) As String

    Dim SH As Shell32.Shell
    Dim F As Shell32.Folder
    Dim WshShell As Object

    Set SH = New Shell32.Shell
    Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
    Set WshShell = CreateObject("WScript.Shell")

    If Not F Is Nothing Then
        'Special folders don't always return their full path that is why we check the title first
        Select Case F.Title
            Case "Desktop"
                BrowseFolder = WshShell.SpecialFolders("Desktop")
            Case "My Documents"
                BrowseFolder = WshShell.SpecialFolders("MyDocuments")
            Case "My Computer"
                MsgBox "Invalid selection", vbCritical + vbOKOnly, "Error"
                Exit Function
            Case "My Network Places"
                MsgBox "Invalid selection", vbCritical + vbOKOnly, "Error"
                Exit Function
            Case Else
                BrowseFolder = F.Items.Item.Path
        End Select
   End If
   
   'Cleanup
   Set SH = Nothing
   Set F = Nothing
   Set WshShell = Nothing

End Function

Sub SaveAttachment()
 
     'Get all selected items
    Set MyOlApplication = CreateObject("Outlook.Application")
    Set MyOlNameSpace = MyOlApplication.GetNamespace("MAPI")
    Set MyOlSelection = MyOlApplication.ActiveExplorer.Selection

    'Make sure at least one item is selected
    If MyOlSelection.Count = 0 Then
       Response = MsgBox("Please select an item first", vbExclamation, MyApplName)
       Exit Sub
    End If
   
    'Make sure only one item is selected
    If MyOlSelection.Count > 1 Then
       Response = MsgBox("Please select only one item", vbExclamation, MyApplName)
       Exit Sub
    End If
   
    'Retrieve the selected item
    Set MySelectedItem = MyOlSelection.Item(1)
 
    'Retrieve all attachments from the selected item
    Dim colAttachments As Outlook.Attachments
    Dim objAttachment As Outlook.Attachment
    Set colAttachments = MySelectedItem.Attachments
   
    'Here makes the user the folder selection
    Dim FolderPath As String
    FolderPath = BrowseFolder("Select a folder")
    If FolderPath = "" Then
        Response = MsgBox("Please select a folder. No items were saved", vbExclamation, MyApplName)
       Exit Sub
    End If
   
    'Save all attachments to the selected location with a date and time stamp of message to generate a unique name
    Dim DateStamp As String
    Dim MyFile As String
    For Each objAttachment In colAttachments
        MyFile = objAttachment.FileName
        DateStamp = Format(MySelectedItem.CreationTime, " - yyyymmdd_hhnnss")
        intPos = InStrRev(MyFile, ".")
        If intPos > 0 Then
            MyFile = Left(MyFile, intPos - 1) & DateStamp & Mid(MyFile, intPos)
        Else
            MyFile = MyFile & "DateStamp"
        End If
       
        objAttachment.SaveAsFile (FolderPath & "\" & MyFile)
    Next
   
    'Cleanup
    Set objAttachment = Nothing
    Set colAttachments = Nothing
    Set MyOlApplication = Nothing
    Set MyOlNameSpace = Nothing
    Set MyOlSelection = Nothing
    Set MySelectedItem = Nothing

End Sub


Important!
Since this macro also uses Windows functionality to prompt you for a folder location we must add the reference to the project. To do this choose Tools-> References… and select Microsoft Shell Controls And Automation. After this press OK.

Now we debug the code by choosing Debug-> Compile Project1. You shouldn’t be getting errors if you’ve done everything correctly.
If you do get errors retrace your steps and also verify that any previous code you might have in ThisOutlookSession is correct. Debug until you’ve solved the errors (the code provided works correctly without any modifications).

To be able to run the code without setting your macro security level to medium I recommend that you sign your code which is a very easy process and only takes a minute.

Create a button for the macro
You can run the macro through Tools-> Macros… -> select the SaveAttachment macro and then press Run. However the easiest way to access and use the macro is to create a button for it. Since the macro works on the selected item we can create the button in the main Outlook window. Follow the instructions below to create a button.

1.Set the Toolbar in edit mode by going to View-> Toolbars-> Customize…
2.Select the tab Commands
3.In the Categories column select Macros
4.In the Commands toolbar click on Project1.SaveAttachment and hold down the mouse button.
5.Drag the icon to a location on the Toolbar so the pointer will loose the cross and release the mouse button to drop it in that location
6.Right click the icon to change the name and to assign it a button image you like (if you want to learn more about editing Toolbar buttons click here)
7.Press Close to leave edit mode

Using the macro
Alright, now that we’ve gone through all the trouble we can finally save all types of embedded pictures in their original file format. To do this you select the message that contains the embedded pictures. When you click on the Save Attachments button you’ll save all attachments with a date and time stamp to a folder of choice. Note that it doesn’t save blocked attachments.

Say good-bye to converting bmp-s back to jpg-s and broken gif-s!
Back to top
View user's profile Send private message Send e-mail
Display posts from previous:   
Post new topic   Reply to topic    Manufacturing Information Solutions Forum Index -> Microsoft All times are GMT - 5 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group