Search code examples
excelvbaemailoutlookattachment

Export Attachment from outlook to excel cells


I've an issue to export attachments from outlook to excel cells. The attachment is not the filename, but the file itself. For example, if PDF file, it will extract the PDF file to the cells, not the filename or the details inside of PDF. I know how to save attachment to the folder but not on the cells. Here is the code :

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

the idea is to embed the attachment received in each emails to column E

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

Solution

  • You will need to save the attachment as a file (Attachment.SaveAsFile, where Attachment object comes from the MailItem.Attachments collection), then insert it as an object using Worksheet.OLEObjects.Add. See https://www.howtoexcel.org/embed-pdf/ for more details.