我目前正在我的项目中,该项目将电子邮件从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
答案 0 :(得分:0)
答案 1 :(得分:0)
您尝试过Attachments
吗?我没有必要这样做,但这就是我最初付出的努力。
MailItem.Attachments.Item(0)
让您处理第一个附件。
由于您的变量OutlookMail包含MailItem
,因此我要做的第一件事是...
ActiveSheet.Pictures.Insert(OutlookMail.Attachments.Item(0))
我想尝试的第二件事是寻找答案。
从电子邮件中提取图片并将图片插入Excel并不是晦涩的任务,因此对于那些寻找图片的人来说,将会有许多详细的示例。
当我问我的滑板是否在前院时,我想起了祖母的反应。她要告诉我的是“看着你的眼睛,而不是你的嘴”。在这里感觉很合适。