Export Attachment from outlook to excel cells

[sephiroth94]

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 :

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

 

[Zaifee]

To export attachments from Outlook to Excel cells, you'll need to iterate through the attachments collection of each email and save them to Excel. Here's an updated version of your code that extracts and saves the attachments to column E in Excel:

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
                
                ' Extract attachments
                If .Attachments.Count > 0 Then
                    For Each attachment In .Attachments
                        ' Save attachment to a temporary file
                        attachment.SaveAsFile "C:\Temp\" & attachment.FileName
                        
                        ' Read the saved file and insert its contents to column E
                        Dim fileContent As String
                        Dim fileNumber As Integer
                        fileNumber = FreeFile()
                        Open "C:\Temp\" & attachment.FileName For Binary As #fileNumber
                        fileContent = Space$(LOF(fileNumber))
                        Get #fileNumber, , fileContent
                        Close #fileNumber
                        
                        ws.Cells(iRow, "E") = fileContent
                        
                        ' Delete the temporary file
                        Kill "C:\Temp\" & attachment.FileName
                    Next attachment
                End If
                
                iRow = iRow + 1
            End With
        End If
    End If
Next olItem

Application.ScreenUpdating = True

In this updated code, the attachments are saved to a temporary file in the "C:\Temp" directory. The contents of the saved file are then read and inserted into column E of the Excel worksheet. Finally, the temporary file is deleted. Make sure to update the file path ("C:\Temp") to a location where you have write access and want to save the temporary files.

Note that this code assumes you have defined the worksheet object "ws" earlier in your code. If not, you can add the following line before the loop:

Set ws = ThisWorkbook.Worksheets("Sheet1") ' Change "Sheet1" to your actual worksheet name

Remember to adjust the worksheet name if it's different from "Sheet1".