Extract Pictures from Email

[anandbohra]

Dear All,

Actuall I had subscribed to a group who send me mails every day (10-15) conataining pictures (as html page & not as attachment) so to save the pictures manually I have to right click on the same & select save picture & save it on the pc but process is manually & very hectic.

so i am requersting u all that can a macro or vba code can be done for the same which can run this proces & save all pictures contained in the emails to the predetermined location.

awaiting for an earliest reply.

[JP2112]

I believe that pictures in HTML emails are actually attachments. Have you tried iterating through the Attachments collection? What happens when you run this code on one of those emails? If the messagebox shows a number greater than zero, then all you need to do is set an object reference to each attachment and save it.

Sub CountAttachments()
Dim MyItem As Outlook.MailItem
    On Error Resume Next
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set MyItem = ActiveExplorer.Selection.item(1)
        Case "Inspector"
            Set MyItem = ActiveInspector.CurrentItem
        Case Else
    End Select
    On Error GoTo 0
 
    If MyItem Is Nothing Then
        GoTo ExitProc
    End If
 
MsgBox MyItem.Attachments.Count
 
ExitProc:
Set MyItem = Nothing
End Sub

Dear All,

Actuall I had subscribed to a group who send me mails every day (10-15) conataining pictures (as html page & not as attachment) so to save the pictures manually I have to right click on the same & select save picture & save it on the pc but process is manually & very hectic.

so i am requersting u all that can a macro or vba code can be done for the same which can run this proces & save all pictures contained in the emails to the predetermined location.

awaiting for an earliest reply.

[anandbohra]

Thanks for the reply sir the message box is showing value more than 1 as suggested by you.

but I checked these are not attachments as when i select the message & click file menu - then save attachments it shown none under it & also when u open the message there are no attachements but HTML page shows the images when u r on the internet (pictures one below other & u can right click & select save pictures as)

now guide me how to accomplish this task

If the messagebox shows a number greater than zero, then all you need to do is set an object reference to each attachment and save it.

Awaiting for your earliest reply

[JP2112]

Programmatically, they are considered attachments. You just can't save them as attachments the way you do with 'normal' attachments.

I have some sample code here that should assist you.

http://www.codeforexcelandoutlook.co...s-choose-your/


HTH,
JP

Thanks for the reply sir the message box is showing value more than 1 as suggested by you.

but I checked these are not attachments as when i select the message & click file menu - then save attachments it shown none under it & also when u open the message there are no attachements but HTML page shows the images when u r on the internet (pictures one below other & u can right click & select save pictures as)

now guide me how to accomplish this task



Awaiting for your earliest reply

[anandbohra]

Thank u so much for the kind help provided

will u pl guide me how to run this process for all the mails in my inbox & instead of select folder method I had hard coded the path

I tested whole code while selecting singe message runs perfect but fails in multiple selection I suppose it extract attachment of only active message & not all selected.

so pl guide me how to amend my code to run for each mails in my Inbox (i have nearly 100 messages which contains natural sceneries which I want to extract pl help)

Final code

    Sub GoThroughAttachments()
    Dim MyItem As Outlook.MailItem
    Dim myAttachments As Outlook.Attachments
    Dim i As Long
    Dim Att As String
    Dim SelectedFolder As String
    On Error Resume Next
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set MyItem = ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set MyItem = ActiveInspector.CurrentItem
        Case Else
    End Select
    On Error GoTo 0
    If MyItem Is Nothing Then
        GoTo ExitProc
    End If
    If MyItem.Attachments.Count > 0 Then
        '          SelectedFolder = SelectFolder()
        '          If SelectedFolder <> "" Then
            ' user didn?t press Cancel
            'Set myAttachments = MyItem.Attachments
            For i = 1 To myAttachments.Count
                Att = myAttachments.Item(i).DisplayName
                myAttachments.Item(i).SaveAsFile "E:\data\" & Att
            Next i
        '          End If
    End If
    ExitProc:
    Set myAttachments = Nothing
    Set MyItem = Nothing
      End Sub

[JP2112]

I have some more sample code that does exactly that. Just highlight the emails with attachments and run the code found here. It should work on single emails as well, and also offers you the option of deleting the emails after the attachments are saved.

http://www.codeforexcelandoutlook.co...ltiple-emails/

Just change the hard-coded path to "E:\data" and you should be set.

--JP

Thank u so much for the kind help provided

will u pl guide me how to run this process for all the mails in my inbox & instead of select folder method I had hard coded the path

I tested whole code while selecting singe message runs perfect but fails in multiple selection I suppose it extract attachment of only active message & not all selected.

so pl guide me how to amend my code to run for each mails in my Inbox (i have nearly 100 messages which contains natural sceneries which I want to extract pl help)

Final code

 Sub GoThroughAttachments()
    Dim MyItem As Outlook.MailItem
    Dim myAttachments As Outlook.Attachments
    Dim i As Long
    Dim Att As String
    Dim SelectedFolder As String
    On Error Resume Next
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set MyItem = ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set MyItem = ActiveInspector.CurrentItem
        Case Else
    End Select
    On Error GoTo 0
    If MyItem Is Nothing Then
        GoTo ExitProc
    End If
    If MyItem.Attachments.Count > 0 Then
        ' SelectedFolder = SelectFolder()
        ' If SelectedFolder <> "" Then
            ' user didn?t press Cancel
             Set myAttachments = MyItem.Attachments
             For i = 1 To myAttachments.Count
                Att = myAttachments.Item(i).DisplayName
                myAttachments.Item(i).SaveAsFile "E:\data\" & Att
            Next i
        ' End If
    End If
    ExitProc:
    Set myAttachments = Nothing
    Set MyItem = Nothing
End Sub

[anandbohra]

Awesome man exactly what I needed
Extract the images & then delete the message

perfect

[JP2112]

Glad to hear it!

Take care,
JP

Awesome man exactly what I needed
Extract the images & then delete the message

perfect