Anyway To Export Email To Folder Including Attachments And Add ID?

[Legacy 286866]

I have a system I have created overtime that puts email data onto an excel spreadsheet. This is great but what I would also like to do after this has run is extract the emails including any attachments from Outlook into a new folder on my Windows PC and then add an ID onto it which is put onto the excel sheet with the data it extracts at the start.
Really kinda new to stuff like this so any help would be great.
Here is the code I have written so far;


<code>Sub Download_Outlook_Mail_To_Excel()
'Add Tools->References->"Microsoft Outlook Object Library"
Dim Folder As Outlook.MAPIFolder
Dim iRow As Integer, oRow As Integer
Dim MailBoxName As String, Pst_Folder_Name As String

'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session)
MailBoxName = "test@hotmail.com"

'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session)
Pst_Folder_Name = "Inbox" 'Sample "Inbox" or "Sent Items"

Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)
If Folder = "" Then
MsgBox "Invalid Data in Input"
GoTo end_lbl1:
End If

'Read Through each Mail and export the details to Excel for Email Archival
ThisWorkbook.Sheets(1).Activate
Folder.Items.Sort "Received"

'Insert Column Headers
ThisWorkbook.Sheets(1).Cells(1, 1) = "Sender"
ThisWorkbook.Sheets(1).Cells(1, 2) = "Subject"
ThisWorkbook.Sheets(1).Cells(1, 3) = "Date"
ThisWorkbook.Sheets(1).Cells(1, 4) = "Size"
ThisWorkbook.Sheets(1).Cells(1, 5) = "EmailID"
ThisWorkbook.Sheets(1).Cells(1, 6) = "Body"

'Insert Mail Data
For iRow = 1 To Folder.Items.Count
oRow = iRow + 1
ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).SenderName
ThisWorkbook.Sheets(1).Cells(oRow, 2) = Folder.Items.Item(iRow).Subject
ThisWorkbook.Sheets(1).Cells(oRow, 3) = Folder.Items.Item(iRow).ReceivedTime
ThisWorkbook.Sheets(1).Cells(oRow, 4) = Folder.Items.Item(iRow).Size
ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress
ThisWorkbook.Sheets(1).Cells(oRow, 6) = Folder.Items.Item(iRow).Body
Next iRow
MsgBox "Outlook Mails Extracted to Excel"

end_lbl1:
End Sub</code>