从 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/。