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

Question

我目前正在处理我的项目，即将电子邮件从 Outlook 导出到我的 Excel 文件。

我当前的代码只导出文本而不是图像。我的一些电子邮件有截图(.png/.jpg)。

有解决办法吗？

这是我当前在 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

看看这个帖子:

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

我认为它应该给你你需要的东西(向下滚动到底部)。