从outlook导出附件到excel单元格

Question

我有一个问题，从outlook导出附件到excel单元格。附件不是文件名，而是文件本身。例如，如果是PDF文件，它会将PDF文件提取到单元格，而不是PDF中的文件名或详细信息。我知道如何保存附件到文件夹，但不是在单元格上。下面是代码:

Sub GetOutlookDetails()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olItem As Object
Dim olMailItem As Outlook.MailItem
Dim ws As Worksheet
Dim iRow As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim lastrow As Long
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
'Set Location Mailbox
Set olFldr = olNS.Folders("Cash Allocations UKI")
Set olFldr = olFldr.Folders("Inbox")
Set olFldr = olFldr.Folders("GB - United Kingdom")
iRow = 5
Application.ScreenUpdating = False
'Find Unread email only in Mailbox
For Each olItem In olFldr.Items
If olItem.UnRead = True Then
If olItem.Class = olMail Then
Set olMailItem = olItem
With olMailItem
ws.Cells(iRow, "A") = .SenderEmailAddress
ws.Cells(iRow, "B") = .Subject
ws.Cells(iRow, "C") = .Body
iRow = iRow + 1
End With

End If
End If
Next olItem
Application.ScreenUpdating = False
'Remove Wrap Text
Columns("C:C").Select
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A5").Select
'To put "."
lastrow = ThisWorkbook.Worksheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
Range("D5:D" & lastrow) = "."
End Sub

这个想法是将每封电子邮件中收到的附件嵌入到E列

ws.Cells(iRow, "E") = .Attachments 'Stuck here

Answer 1

您需要将附件保存为文件(Attachment.SaveAsFile，其中Attachment对象来自MailItem.Attachments集合)，然后使用Worksheet.OLEObjects.Add将其作为对象插入。详见https://www.howtoexcel.org/embed-pdf/