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.com/blog/2008/05/save-incoming-attachments-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 :bow: :bow: :bow: :bow: :bow:

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.com/blog/2008/08/processing-multiple-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 :bow: :bow: :bow: :bow: :bow:

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 :beerchug:



:clap::clap::clap::clap::clap:

[JP2112]

Glad to hear it!

Take care,
JP


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

perfect :beerchug:



:clap::clap::clap::clap::clap: