如果共享邮箱已满90%,请从共享邮箱中删除电子邮件

时间:2019-09-27 10:59:03

标签: vba outlook-vba outlook-2016

我们正在使用几个共享邮箱,并且想要设置一个宏来检查其中一个邮箱是否已满90%,然后它应该删除1000封最旧的电子邮件。

我找到了我已成功修改的脚本,但是它正在检查电子邮件的存续时间,而不是邮箱是否已满。

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

如果我要检查邮箱大小并采取相应措施,应该如何修改此代码?或者应该如何开始?

1 个答案:

答案 0 :(得分:0)

我已经退休,并且已经八年没有访问共享邮箱了。我记得在私人商店工作的VBA也在共享商店工作。因此,以下代码应为您工作,但我尚未在共享邮箱上对其进行测试。

我一直在尝试问题的第一部分:使用VBA确定商店的规模。我的结果不一致。

我有两个存储(存档文件夹和备份),我不记得要创建,因此我认为它们是随安装一起提供的。

存档文件夹有四个可见文件夹(垃圾邮件,草稿,已删除邮件和已发送邮件)和三个不可见文件夹(任务,日记和日历)和一个伪文件夹(搜索文件夹)。该存储区从未使用过,所有文件夹均为空。

备份具有四个可见文件夹(垃圾电子邮件,草稿,已删除邮件和收件箱),相同的不可见文件夹和相同的伪文件夹。由于我使用此商店测试宏,因此收件箱中有两封电子邮件。

“可见”是指它们出现在“ Outlook文件夹”窗格中,并且可以通过VBA访问。 “不可见”是指它们没有出现在“ Outlook文件夹”窗格中,但是可以通过VBA访问。 “伪”是指它们出现在“ Outlook文件夹”窗格中,但不能通过VBA访问。

对这些存储中的项目大小进行总计,得出的归档文件夹的项目总大小为0字节,而备份的项目总大小为66,207字节。使用“文件资源管理器”访问这些文件并查看“属性”,得出的文件总大小为265 KB或271,360字节,而磁盘上的大小稍大。

昨晚,我的主要存储(这是我的邮件帐户存储之一)中的项目总大小为507,896,393字节。 File Explorer文件大小为733,938,688字节,压缩后减少为609,756,160字节。今天早上,在收到更多电子邮件之后,项目的总大小已增加到508,834,935字节,但文件大小未更改。 Outlook的“邮箱设置”为此文件夹提供了496,845 KB的大小。注意:496,845 * 1,024 = 508,769,280字节,尽管该项目除了邮件项目之外没有其他内容,但小于项目的总大小。

下面的代码计算其可以访问的每个商店的总商品大小。也许您可以看到我错过的模式。或者,知道系统何时抱怨邮箱大小时,可以推断出需要采取操作的总项目大小。

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