Getting data out of Outlook using a VBA or a COM Script is not that difficult.
But when you want to reach the data in a Shared Mailbox that’s a different story !
There are different options :
1. VBA script in Outlook export to clipboard
2. VBA script in Excel and export to a sheet
3. PS script that that can handle both Outlook and Excel sheet Export
SOLUTION :
Outlook Script that can export to a clipboard.
But it runs quite slow and is depending on Microsoft Forms Library.
That is not by default available, so you need reference it.
The COM Library located here C :\WINDOWS\SysWOW64\FM2O. DLL
Sub ListMailsInFolder()
Dim clipboard As New MSForms.DataObject
Set clipboard = New MSForms.DataObject
Dim txt As String
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim olShareName As Outlook.Recipient
Dim MailItems As MailItem
Dim FmtToday As String
FmtToday = Format(Date - 1, "DDDDD HH:NN")
Debug.Print DateValue(Now()) - 1
Set objNS = GetNamespace("MAPI")
Set olShareName = objNS.CreateRecipient("outbound@yourcompany.com")
'Set objFolder = objNS.Folders.GetFirst ' folders of your current account
'Shared Inbox
Set objFolder = objNS.GetSharedDefaultFolder(olShareName, olFolderInbox) '// Inbox
Set Items = objFolder.Items.Restrict("[ReceivedTime] > '" & FmtToday & "'")
Debug.Print Items.Count
For Each MailItems In Items
'If TypeName(Item) = "MailItem" Then
' ... do stuff here ...
Debug.Print MailItems.Subject & " " & MailItems.ReceivedTime
'End If
'Put some text inside a string variable
txt = txt & MailItems.Subject & " " & MailItems.ReceivedTime & vbNewLine
'Sleep (500)
Next
'Make object's text equal above string variable
clipboard.SetText txt
' SubFolder
Set objFolder = objNS.GetSharedDefaultFolder(olShareName, olFolderInbox).Parent.Folders("Shipments") '
Set Items = objFolder.Items.Restrict("[ReceivedTime] > '" & FmtToday & "'")
Debug.Print "[ReceivedTime] > '" & FmtToday & "'"
Debug.Print Items.Count
For Each MailItems In Items
'If TypeName(Item) = "MailItem" Then
' ... do stuff here ...
Debug.Print MailItems.Subject & " " & MailItems.ReceivedTime
'End If
'Put some text inside a string variable
txt = txt & MailItems.Subject & " " & MailItems.ReceivedTime & vbNewLine
'Sleep (500)
Next
'Make object's text equal above string variable
clipboard.SetText txt
'Place DataObject's text into the Clipboard
clipboard.PutInClipboard
End Sub
Initially it ran very SLOW, so I optimized it for speed using the RESTRICT method FILTERING.
Which runs a lot FASTER. 
You can convert this an Excel Macro to EXPORT it to a workbook sheet.
I added a input box to select the date FROM and TO, as well as added a Calendar Control 
See here on how to add a Calendar Control
https://www.ablebits.com/office-addins-blog/2016/10/12/insert-calendar-excel-datepicker-template/
Option Explicit
Sub Button1_Click()
On Error GoTo ErrHandler
Columns("A:C").Select
Selection.ClearContents
Dim dStartDate As Date
Dim dEndDate As Date
'Enter the specific start date and end date
dStartDate = InputBox("Enter the start date, such as 7/1/201x:", "Specify Start Date", Range("F2").Value)
dEndDate = InputBox("Enter the end date, such as 8/31/201x:", "Specify End Date", Date)
If dStartDate <> #1/1/4501# And dEndDate <> #1/1/4501# Then
' Set Outlook APPLICATION OBJECTS.
Dim Outlook As Object
Set Outlook = CreateObject("Outlook.Application")
Dim clipboard As New MSForms.DataObject
Dim txt As String
Const olFolderInbox = 6
Dim objNS As Object
Dim Items As Object
Dim Item As Object
Dim objFolder As Outlook.MAPIFolder
Dim olShareName As Outlook.Recipient
Set objNS = GetNamespace("MAPI")
Set olShareName = objNS.CreateRecipient("outbound@yourcompany.com")
'Set objFolder = objNS.Folders.GetFirst ' folders of your current account
'Shared Mailbox Inbox
Set objFolder = objNS.GetSharedDefaultFolder(olShareName, olFolderInbox) '// Inbox
Set Items = objFolder.Items
Set clipboard = New MSForms.DataObject
Dim iRows, iCols As Integer
iRows = 2
For Each Item In objFolder.Items
'If TypeName(Item) = "MailItem" Then
' ... do stuff here ...
Debug.Print Item.Subject
'End If
'Put some text inside a string variable
txt = txt & Item.Subject & vbNewLine
If Format(Item.ReceivedTime, "dd/MM/YYYY") >= dStartDate And Format(Item.ReceivedTime, "dd/MM/YYYY") <= dEndDate Then
Cells(iRows, 1) = Item.Subject
Cells(iRows, 3) = Item.ReceivedTime
iRows = iRows + 1
End If
Next
'Make object's text equal above string variable
clipboard.SetText txt
' Shared Mailbox SubFolder(s)
Set objFolder = objNS.GetSharedDefaultFolder(olShareName, olFolderInbox).Parent.Folders("Shipments")
'.Parent.Folders("Shipments").Folders("_ToDo") ' Subfolders
Set Items = objFolder.Items
For Each Item In objFolder.Items
'If TypeName(Item) = "MailItem" Then
' ... do stuff here ...
Debug.Print Item.Subject
'End If
'Put some text inside a string variable
txt = txt & Item.Subject & vbNewLine
'Debug.Print Format(Item.ReceivedTime, "dd/MM/YYYY") & " - " & dStartDate
If Format(Item.ReceivedTime, "dd/MM/YYYY") >= dStartDate And Format(Item.ReceivedTime, "dd/MM/YYYY") <= dEndDate Then
Cells(iRows, 1) = Item.Subject
Cells(iRows, 3) = Item.ReceivedTime
iRows = iRows + 1
End If
Next
'Object's text to Clipboard
clipboard.SetText txt
'Place DataObject's text into the Clipboard
clipboard.PutInClipboard
' Release Objects
Set Outlook = Nothing
Set objNS = Nothing
Set olShareName = Nothing
Set clipboard = Nothing
Set objFolder = Nothing
Set Items = Nothing
End If
ErrHandler:
Debug.Print Err.Description
End Sub
This is the PowerShell Version !
CLS
[void][Reflection.Assembly]::LoadWithPartialName('Microsoft.VisualBasic')
$title = "Start Date"
$msg = "From"
$default = (Get-Date).AddDays(-1).ToString("d") # Get-Date -UFormat "%m/%d//%Y" or (Get-Date).AddDays(-1).ToString("MM/dd/yyyy")
$sDate = [Microsoft.VisualBasic.Interaction]::InputBox($msg, $title, $default)
[string]$sDate += " 00:00" # + (Get-Date).tostring(‘t’)
[threading.thread]::CurrentThread.CurrentCulture = 'en-US' # Important line !!
$excel = New-Object -ComObject Excel.Application
$excel.Visible = $true
$workbook = $excel.Workbooks.Add()
$workbook.WorkSheets.Item(1).Name = "Outbound"
$sheet = $workbook.ActiveSheet
$olFolderInbox = 6
Add-type -assembly “Microsoft.Office.Interop.Outlook” | out-null
$outlook = new-object -comobject outlook.application
$namespace = $outlook.GetNameSpace(“MAPI”)
$olShareName = $namespace.CreateRecipient("outbound@yourcompany.com")
$olShareName.Resolved()
$sFilter = ("[ReceivedTime] >= '$olddate'")
# Shared Inbox
$Folder = $namespace.GetSharedDefaultFolder($olShareName, $olFolderInbox)
$Items = $Folder.Items.Restrict("[ReceivedTime] > '$sDate'")
$Items | Select-Object -Property Subject, ReceivedTime, SenderName, SenderEmailAddress | ? {$_ -match "@"}
# $Items | Export-CSV -NoTypeInformation XXXX\Trial.csv
$counter = 0
foreach($Item in $Items){
$Email = ($Item.SenderEmailAddress | ? {$_ -match "@"})
# ($Item.Subject + " " + $Item.ReceivedTime + " " + $Item.SenderName + " " + $Email)
$counter++
$sheet.cells.Item($counter,1) = $Item.Subject
$sheet.cells.Item($counter,3) = $Item.ReceivedTime.Date
}
# SubFolder
$SubFolder = $Folder.Parent.Folders("Shipments")
$olddate = (Get-Date).AddDays(-2).ToLongDateString()
$Items = $SubFolder.Items.Restrict("[ReceivedTime] > '$sDate'")
$Items | Select-Object -Property Subject, ReceivedTime, SenderName, SenderEmailAddress | ? {$_ -match "@"}
# $array | Export-CSV -NoTypeInformation XXXX\Trial.csv
foreach($Item in $Items){
$Email = ($Item.SenderEmailAddress | ? {$_ -match "@"})
# ($Item.Subject + " " + $Item.ReceivedTime + " " + $Item.SenderName + " " + $Email)
$counter++
$sheet.cells.Item($counter,1) = $Item.Subject
$sheet.cells.Item($counter,3) = $Item.ReceivedTime.Date
}
$sheet.Cells.EntireColumn.AutoFit()
[System.Runtime.Interopservices.Marshal]::ReleaseComObject($Outlook)
[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel)
# Stop-Process -Name EXCEL -Force
Remove-Variable Excel, Email
Enjoy !!
Advertisements
Posted by audministrator 
the very nice 
