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 !!