Delete emails from a shared mailbox if it's 90% full

Question

There are several shared mailboxes we are using, and would like to set up one macro to check if one of the mailboxes is 90% full then it should delete the 1000 oldest emails.

I have found a script what I have successfully modified but it is checking the age of the emails not if mailbox is full.

aged = 2

On Error Resume Next
Set outlookAPP = Outlook.Application
Set outlookNS = outlookAPP.GetNamespace("MAPI")
Set maliboxOwner_1 = outlookNS.CreateRecipient("shared@mailbox.address.com")
Set Shared_email_address = outlookNS.GetSharedDefaultFolder(maliboxOwner_1, olFolderInbox)

On Error Resume Next
For number_of_emails_1 = Shared_email_address.Items.Count To 1 Step -1
    Set objectVariant = Shared_email_address.Items.Item(number_of_emails_1)
    DoEvents
    If objectVariant.Class = olMail Then

         if_date_differenece_is = DateDiff("d", objectVariant.SentOn, Now)

        ' Set number of days
        If if_date_differenece_is > aged Then
          objectVariant.Delete
          'Call ClearDeletedFolder ' Working. Will change to call every 100 emails deleted after first run.

          'count the # of items moved
           lngMovedItems = lngMovedItems + 1

        ' No need to run the IF statement on the rest of the mailbox assuming the macro runs from oldest to newest.
        'Else: GoTo Marker

        End If
    End If
Next
On Error Resume Next

how should this code be modified or how should I start if I would like this to check the mailbox size and act accordingly?

As I understand it, the size of a shared mailbox is set on the server by an administrator. I cannot find any information that suggests you have VBA access to the maximum size. You might have user access to the maximum and current size via Mailbox Settings or you might need to ask the administrator although it sounds as though you already know the maximum size. If you have access to the server containing the store, a macro could check the current size. Should you be deleting these emails? What about corporate records? Wouldn’t it be better to archive old emails? — Tony Dallimore, Sep 27 '19 at 13:01
If there is no way to get a mailbox size directly, you could sum the size of all the items in all the folders. Start here https://stackoverflow.com/questions/2272361/can-i-iterate-through-all-outlook-emails-in-a-folder-including-sub-folders if there are subfolders in the inbox. — niton, Sep 27 '19 at 14:29
@TonyDallimore yes you are right. So to clarify and sorry for phrasing it wrongly, so I can not see the maximum size nor the used up size, but I have asked and received info about the maximum size what is 1GB, so the script should check the size of existing emails add them up and if it's over 90% of the mailbox size I would like them to be deleted. This email are from a test system so these can be deleted. — mabanger, Oct 01 '19 at 10:30

score 0 · Accepted Answer · answered Oct 02 '19 at 14:37

I am retired and have not had access to a shared mailbox for eight years. My recollection is that the VBA that worked on private stores also worked on shared ones. So the code below should work for you but I have not tested it on a shared mailbox.

I have been experimenting with the first part of your problem: determining the size of a store using VBA. My results have been inconsistent.

I have two stores (Archive Folders and Backup) that I do not remember creating so I assume they came with the installation.

Archive Folders has four visible folders (Junk Email, Drafts, Deleted Items and Sent Items) and three invisible folders (Tasks, Journal and Calendar) and one pseudo-folder (Search Folders). This store has never been used and all folders are empty.

Backup has four visible folders (Junk Email, Drafts, Deleted Items and InBox), the same invisible folders and the same pseudo-folder. There are two emails in Inbox as the result of me using this store to test a macro.

By “visible” I mean they appear in the Outlook Folder pane and are accessible with VBA. By “invisible” I mean they do not appear in the Outlook Folder pane but are accessible with VBA. By “pseudo” I mean they appear in the Outlook Folder pane but are not accessible with VBA.

Summing the size of the items within these stores gives a total item size for Archive Folders of 0 bytes and a total item size for Backup of 66,207 bytes. Accessing these files with File Explorer and looking at Properties, gives a total file size for either of 265 KB or 271,360 bytes with the size on disk being a little bigger.

Last night, the total size of the items within my principal store (which is one of my mail account stores) was 507,896,393 bytes. The File Explorer file size was 733,938,688 bytes which reduced to 609,756,160 bytes after compaction. This morning, after receiving a few more emails, the total item size has increased to 508,834,935 bytes but the file size is unchanged. Outlook’s Mailbox Setting’s gives the size of this folder as 496,845 KB. Note: 496,845 * 1,024 = 508,769,280 bytes which is less than the total item size although there is nothing in that store except mail items.

The code below calculates the total item size of every store it can access. Perhaps you can see a pattern I have missed. Or, knowing when the system complains about the mailbox size, you can deduce the total item size at which you need to take action.

Option Explicit
Sub CalcSizeOfAllStores()

  ' Displays name of each store and the size of its contents

  Dim FldrCrnt As Folder
  Dim InxFldrChild As Long
  Dim InxStoreCrnt As Long
  Dim StoreCrnt As Folder
  Dim StoreSize As Long
  Dim TotalSize As Long

  TotalSize = 0&

  With Application.Session
    For InxStoreCrnt = 1 To .Folders.Count
      Set StoreCrnt = .Folders(InxStoreCrnt)
      With StoreCrnt
        StoreSize = 0&
        For InxFldrChild = .Folders.Count To 1 Step -1
          Set FldrCrnt = .Folders(InxFldrChild)
          StoreSize = StoreSize + GetSizeOfFolder(FldrCrnt)
        Next
        Debug.Print PadL(Format(StoreSize, "#,##0"), 15) & "  " & .Name
        TotalSize = TotalSize + StoreSize
      End With
    Next
  End With

  Debug.Print String(15, "-")
  Debug.Print PadL(Format(TotalSize, "#,##0"), 15)

End Sub
Function GetSizeOfFolder(FldrCrnt) As Long

  ' Return the size of every item within FldrCrnt and its children  
  Dim InxFldrChild As Long
  Dim InxItem As Long
  Dim FolderSize As Long

  FolderSize = 0&

  With FldrCrnt

    ' Get Total size of items within folder
    For InxItem = .Items.Count To 1 Step -1
      FolderSize = FolderSize + .Items(InxItem).Size
    Next

    ' Add size of each child folder
    For InxFldrChild = .Folders.Count To 1 Step -1
      FolderSize = FolderSize + GetSizeOfFolder(.Folders(InxFldrChild))
    Next

    'Debug.Print "  " & PadL(Format(FolderSize, "#,##0"), 15) & "  " & .Name
  End With


  GetSizeOfFolder = FolderSize

End Function

Delete emails from a shared mailbox if it's 90% full

1 Answers1