Удаление повторяющихся задач на основе количества символов в теле

Question

В настоящее время я запускаю макрос, который запускает правило при запуске, чтобы создать задачу, а затем удаляет дублирующиеся задачи.Однако, поскольку я делаю правки для новых задач, макрос не распознает, что есть две задачи с одинаковым именем, потому что основной текст отличается.Есть ли способ изменить макрос для поиска количества символов в основном тексте?например

If .body>"32" Then
  ?????
End If

Вот код, который у меня сейчас есть.Оригинальный код от https://www.datanumen.com/blogs/quickly-remove-duplicate-outlook-items-folder-via-vba/ & https://www.slipstick.com/outlook/rules/run-outlook-rules-startup/

Private Sub Application_Startup()
RunAllInboxRules
RemoveDuplicateItems
End Sub

Sub RunAllInboxRules()
Dim st As Outlook.Store
Dim myRules As Outlook.Rules
Dim rl As Outlook.Rule
Dim count As Integer
Dim ruleList As String
'On Error Resume Next

' get default store (where rules live)
Set st = Application.Session.DefaultStore
' get rules
Set myRules = st.GetRules

' iterate all the rules
For Each rl In myRules
    ' determine if it's an Inbox rule
          If rl.RuleType = olRuleReceive And rl.IsLocalRule = True Then
        ' if so, run it
        rl.Execute ShowProgress:=True
        count = count + 1
        ruleList = ruleList & vbCrLf & rl.Name
    End If
Next

' tell the user what you did
ruleList = "These rules were executed against the Inbox: " & vbCrLf & ruleList
MsgBox ruleList, vbInformation, "Macro: RunAllInboxRules"

Set rl = Nothing
Set st = Nothing
Set myRules = Nothing
End Sub

Sub RemoveDuplicateItems()
Dim objFolder As Folder
Dim objDictionary As Object
Dim i As Long
Dim objItem As Object
Dim strKey As String

Set objDictionary = CreateObject("scripting.dictionary")
'Select a source folder
Set objFolder = Outlook.Application.Session.PickFolder

If Not (objFolder Is Nothing) Then
   For i = objFolder.Items.count To 1 Step -1
       Set objItem = objFolder.Items.Item(i)

       Select Case objFolder.DefaultItemType
              'Check email subject, body and sent time
              Case olMailItem
                   strKey = objItem.subject & "," & objItem.Body & "," & objItem.SentOn
              'Check appointment subject, start time, duration, location and body
              Case olAppointmentItem
                   strKey = objItem.subject & "," & objItem.Start & "," & objItem.Duration & "," & objItem.Location & "," & objItem.Body
              'Check contact full name and email address
              Case olContactItem
                   strKey = objItem.FullName & "," & objItem.Email1Address & "," & objItem.Email2Address & "," & objItem.Email3Address
              'Check task subject, start date, due date and body
              Case olTaskItem
                   strKey = objItem.subject & "," & objItem.StartDate & "," & objItem.DueDate & "," & objItem.Body
       End Select

       strKey = Replace(strKey, ", ", Chr(32))

       'Remove the duplicate items
       If objDictionary.Exists(strKey) = True Then
          objItem.Delete
       Else
          objDictionary.Add strKey, True
       End If
   Next i
End If
End Sub

Answer 1

Вот как вы можете проверить длину .Body - используя число вместо строки.

If Len(.Body) > 32 Then