I have been ill so I haven't been able to review this much.
I guess post #3 was supposed to be VBA for Outlook code.
This code is for Excel. If it were me, I would make it even more simple and run the macro from the Excel file that gets the details. You should be able to gleam how I added the Column E attachments count data.
Sub CopyToExcel()
Dim xlApp As Application
Dim xlWB As Workbook
Dim xlSheet As Worksheet
Dim bXStarted As Boolean
Dim enviro As String
Dim strPath As String
Dim currentExplorer As Explorer
Dim Sel As Object
Dim olItem As Outlook.MailItem
Dim obj As Object
Dim strColA$, strColB$, strColC$, strColD$, strColE$
Dim strRecipients As String
Dim Recipient As Outlook.Recipient
Dim olEU As Outlook.ExchangeUser
Dim oEDL As Outlook.ExchangeDistributionList
Dim recip As Outlook.Recipient
Dim rCount As Long
' Get Excel set up
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'## Open a specific workbook to input the data
'the path of the workbook under the windows user account
'enviro = CStr(Environ("USERPROFILE"))
strPath = "C:\LK\ABCDE.xlsx"
'strPath = ThisWorkbook.Path & "\OutlookData.xlsx"
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")
'## End Specific workbook
'## Use New Workbook
'Set xlWB = xlApp.Workbooks.Add
'Set xlSheet = xlWB.Sheets("Sheet1")
'## end use new workbook
' Add column names
xlSheet.Range("A1") = "Sender"
xlSheet.Range("B1") = "Sender address"
xlSheet.Range("C1") = "Recieved Time"
xlSheet.Range("D1") = "Recipient(s)"
xlSheet.Range("E1") = "Attachments Count"
' Process the message record
'On Error Resume Next
'Find the next empty line of the worksheet
'rCount = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row
rCount = xlSheet.Cells(xlSheet.Rows.Count, "A").End(xlUp).Row
'needed for Exchange 2016. Remove if causing blank lines.
rCount = rCount + 1
' get the values from outlook
Set currentExplorer = Outlook.ActiveExplorer
Set Sel = currentExplorer.Selection
For Each obj In Sel
If TypeName(obj) <> "MailItem" Then GoTo NextObj
Set olItem = obj 'can be elimated and just use obj rather than olItem
'collect the fields
strColA = olItem.SenderName
strColB = olItem.SenderEmailAddress
'strColC = olItem.Body
'strColD = olItem.To
strColC = olItem.ReceivedTime
strColE = olItem.Attachments.Count
'### Get all recipient addresses
' instead of To names
For Each Recipient In olItem.Recipients
strRecipients = Recipient.Address & "; " & strRecipients
Next Recipient
strColD = strRecipients
'### end all recipients addresses
'### Get the Exchange address
' if not using Exchange, this block can be removed
Set recip = Outlook.Session.CreateRecipient(strColB)
If InStr(1, strColB, "/") > 0 Then
' if exchange, get smtp address
Select Case recip.AddressEntry.AddressEntryUserType
Case OlAddressEntryUserType.olExchangeUserAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then strColB = olEU.PrimarySmtpAddress
Case OlAddressEntryUserType.olOutlookContactAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then strColB = olEU.PrimarySmtpAddress
Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
Set oEDL = recip.AddressEntry.GetExchangeDistributionList
If Not (oEDL Is Nothing) Then strColB = olEU.PrimarySmtpAddress
End Select
End If
' ### End Exchange section
'write them in the excel sheet
xlSheet.Range("A" & rCount) = strColA ' sender name
xlSheet.Range("B" & rCount) = strColB ' sender address
'xlSheet.Range("C" & rCount) = strColC ' message body
xlSheet.Range("C" & rCount) = strColC ' recieved time
xlSheet.Range("D" & rCount) = strColD ' sent to
xlSheet.Range("E" & rCount) = strColE ' sent to/recipient(s)
'Next row
rCount = rCount + 1
NextObj:
Next obj
'Format columns
xlSheet.Columns("A:E").EntireColumn.AutoFit
'xlSheet.Columns("C:C").ColumnWidth = 100
'xlSheet.Columns("D:D").ColumnWidth = 30
'xlSheet.Range("A2").Select
xlSheet.Columns("A:E").VerticalAlignment = xlTop
xlApp.Visible = True
' to save but not close
'xlWB.Save
' to save and close
' xlWB.Close 1
' If bXStarted Then
' xlApp.Quit
' End If
' end save and close
Set olItem = Nothing
Set obj = Nothing
Set currentExplorer = Nothing
Set xlSheet = Nothing
Set xlWB = Nothing
Set xlApp = Nothing
MsgBox ""
End Sub