PowerShell – VBA Read Outlook Emails and Export to Excel

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

 

image

 

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. Smile

 

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 Winking smile

image

image

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

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.

%d bloggers like this: