时间戳

首页 > 解决方案 > 根据正文中的字符数删除重复任务

vba - 根据正文中的字符数删除重复任务

问题描述

我目前正在运行一个宏，该宏在启动时运行规则以创建任务，然后删除重复的任务。但是，因为我正在对新任务进行编辑，宏无法识别有两个同名任务，因为正文不同。有没有办法修改宏来查找正文中的字符数？例如

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-规则启动/

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

标签： vbaoutlook

解决方案

以下是如何.Body使用数字而不是字符串来检查 - 的长度。

If Len(.Body) > 32 Then

推荐阅读