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

我认为它应该可以满足您的需求（向下滚动到底部）。

Answer 2

您尝试过Attachments吗？我没有必要这样做，但这就是我最初付出的努力。

MailItem.Attachments.Item(0)让您处理第一个附件。

由于您的变量OutlookMail包含MailItem，因此我要做的第一件事是...

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

我想尝试的第二件事是寻找答案。

从电子邮件中提取图片并将图片插入Excel并不是晦涩的任务，因此对于那些寻找图片的人来说，将会有许多详细的示例。

当我问我的滑板是否在前院时，我想起了祖母的反应。她要告诉我的是“看着你的眼睛，而不是你的嘴”。在这里感觉很合适。

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

2 个答案: