如何去重.pst文件重复邮件

远方未来

如主题，背景介绍：一个公共邮箱用来分发产生的数据邮件，每天400封左右。公邮内存99G，实际运行过程快满内存，邮箱自动删除邮件。
现：IT已恢复既往2023.1-9月自动删除的文件，但PST多达34个，也就是说实际这个邮箱大概发送了100G左右邮件，但备份有324G左右。

需求：
1、如何将这34个pst里边邮件跑一遍，去重，删除多余邮件或内存？
2、最终得到唯一的邮件，再合并PST，希望得到12个左右PST，每个10Gb左右。

我搜了一下网络上的VBA代码，但是VBA代码在outlook客户端运行显示编译错误，跑不起来。


Sub RemoveDuplicates()
    Dim objFolder As Folder
    Dim objMail As MailItem
    Dim objNewMail As MailItem
    Dim arrMails() As Variant
    Dim i As Long, j As Long
    Dim bExists As Boolean
    Dim strPstPath As String
   
    ' Set the path to the PST file
    strPstPath = D:\old\Exchange.pst' Replace with the actual path to your PST file
   
    ' Loop through each PST file
    For Each objFolder In Application.Session.Folders
        If objFolder.Name Like "*.pst" Then
            ' Read mails from the current PST file
            arrMails = objFolder.Items.Restrict("[Received] >= '" & DateAdd("m", -12, Date) & "'").Sort("[Received] DESC" & vbCrLf & "Ascending:=False") ' Modified line here
            ReDim Preserve arrMails(1 To UBound(arrMails))
            
            ' Loop through each mail in the current PST file
            For i = 1 To UBound(arrMails)
                Set objMail = arrMails(i)
                bExists = False
               
                ' Check if the mail has already been processed (exists in the array)
                For j = 1 To UBound(arrMails)
                    If arrMails(j).Subject = objMail.Subject And arrMails(j).ReceivedTime = objMail.ReceivedTime Then
                        bExists = True
                        Exit For
                    End If
                Next j
               
                ' If the mail is not processed, add it to the array and set bExists to True
                If Not bExists Then
                    Set objNewMail = objMail.Copy
                    arrMails(UBound(arrMails) + 1) = objNewMail
                End If
            Next i
        End If
    Next objFolder
End Sub


以上，求助各位大佬，请指正。