Question

我有这个宏在我的＆＃34; log＆＃34;中创建一个事件。电子邮件中的日历如果标记/标记为＆＃34;今天＆＃34;。我的问题是宏正在创建相同的事件三次。

Public WithEvents OlItems As Outlook.Items

Public Sub Initialize_handler()
   Set OlItems = Application.GetNamespace("MAPI"). _
        GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub OlItems_ItemChange(ByVal Item As Object)

Dim Ns As Outlook.NameSpace
Dim objApp As Outlook.Application
Dim olAppt As Outlook.AppointmentItem


If Item.IsMarkedAsTask = oIMarkToday Then

Set Ns = Application.GetNamespace("MAPI")
Set objApp = Application


  ' Subfolder named 'Log' under calendar
Set calFolder = Ns.GetDefaultFolder(olFolderCalendar).Folders("Log")
Set olAppt = calFolder.Items.Add(olAppointmentItem)
With olAppt
        .Subject = Item.Subject
        '.Attachments.Add Item
        .Body = Item.Body
        .Start = Now + 2
        .End = Now + 2.08
        .ReminderSet = False
        .BusyStatus = olFree
        .Save
        '.Display 'show to add notes
End With
Set objApp = Nothing
Set Ns = Nothing

End If

End Sub

Answer 1

每次更改项目时，您的代码都会运行。设置您自己的自定义属性（Item.UserProperties.Add / Item.Save）以将其标记为已处理，并在创建新项目之前检查该属性（Item.UserProperties.Find）以及Item.IsMarkedAsTask = oIMarkToday检查。

Private Sub OlItems_ItemChange(ByVal Item As Object)

Dim Ns As Outlook.NameSpace
Dim objApp As Outlook.Application
Dim olAppt As Outlook.AppointmentItem
Dim objProp As Outlook.UserProperty

set objProp = Item.UserProperties.Find("ProcessedByMe")

If (Item.IsMarkedAsTask) And (objProp Is Nothing) Then

  'mark the original item as processed
  set  objProp = Item.UserProperties.Add("ProcessedByMe", olYesNo)
  objProp.Value = true
  Item.Savwe

  Set Ns = Application.GetNamespace("MAPI")
  Set objApp = Application

   ' Subfolder named 'Log' under calendar
  Set calFolder = Ns.GetDefaultFolder(olFolderCalendar).Folders("Log")
  Set olAppt = calFolder.Items.Add(olAppointmentItem)
  With olAppt
        .Subject = Item.Subject
        '.Attachments.Add Item
        .Body = Item.Body
        .Start = Now + 2
        .End = Now + 2.08
        .ReminderSet = False
        .BusyStatus = olFree
        .Save
        '.Display 'show to add notes
  End With
  Set objApp = Nothing
  Set Ns = Nothing

End If

End Sub

使用ItemChange事件时代码不必要地运行

1 个答案: