将电子邮件从 Outlook 导出到 Excel 包括图像

Question

I am currently working on my project which is to export emails from Outlook to my Excel file.

My current code is only exporting texts and not images. Some of my emails have a snipped images (.png/.jpg).

Is there a fix to this?

Here's my current code on Excel:

Sub getDataFromOutlook()

'~~Declarations~~'
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer

'~~Set email to be saved~~'
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("SAMPLE")

i = 1


For Each OutlookMail In Folder.Items
'~~Write to Excel~~'
If OutlookMail.ReceivedTime >= Range("email_Receipt_Date").Value Then
    Range("email_Subject").Offset(i, 0).Value = OutlookMail.Subject
    Range("email_Subject").Offset(i, 0).Columns.AutoFit
    Range("email_Subject").Offset(i, 0).VerticalAlignment = xlTop
    Range("email_Date").Offset(i, 0).Value = OutlookMail.ReceivedTime
    Range("email_Date").Offset(i, 0).Columns.AutoFit
    Range("email_Date").Offset(i, 0).VerticalAlignment = xlTop
    Range("email_Sender").Offset(i, 0).Value = OutlookMail.SenderName
    Range("email_Sender").Offset(i, 0).Columns.AutoFit
    Range("email_Sender").Offset(i, 0).VerticalAlignment = xlTop
    Range("email_Body").Offset(i, 0).Value = OutlookMail.Body
    Range("email_Body").Offset(i, 0).Columns.AutoFit
    Range("email_Body").Offset(i, 0).VerticalAlignment = xlTop

    i = i + 1
End If

Next OutlookMail

'~~Set to Null~~'
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

Answer 1

Have a look at this post:

How to copy Outlook mail message into excel using VBA or Macros

I think it should give you what you need (scroll down toward the bottom).

Answer 2

Have you tried Attachments ? I haven't had the need to do this but that's where I'd put my initial effort.

MailItem.Attachments.Item(0) let's you work with the first attachment.

Since your variable OutlookMail holds a MailItem , the first thing I would try is...

ActiveSheet.Pictures.Insert(OutlookMail.Attachments.Item(0))

The second thing I would try is searching for an answer.

Pulling pictures from emails and inserting pictures into Excel are not obscure tasks so there will be many detailed examples available to those who look for them.

I'm reminded of my grandmother's response when I'd ask if my skateboard was in the front yard. "Look with your eyes, not your mouth", is what she'd tell me. That feels appropriate here.