用于删除Outlook日历生日的插件VB.net

时间:2015-04-22 12:08:43

标签: vb.net calendar outlook

我已经和这个人打了几天了。我被要求创建一个Outlook插件(用于Outlook 2013),它将删除我们使用的CRM系统已同步到Outlook日历的所有生日。

在我的测试中,我有插件工作,以便删除一些生日,但不是全部。为了测试,我将6个联系人的生日添加到日历中,当我运行插件时,它似乎一次只删除4个或更少。我需要重新启动Outlook并重新运行插件才能删除更多生日。该插件在启动时运行。我还测试了一个计时器等待60秒然后尝试,但结果相同。我似乎无法通过主题中的“生日”删除所有约会。

请参阅下面的代码。

Public Class ThisAddIn

    Private WithEvents _timer As New System.Windows.Forms.Timer()

    Dim objAppointment As Outlook.AppointmentItem
    Dim lngDeletedAppointements As Long
    Dim objCalFolder As Outlook.MAPIFolder
    Dim objNamespace As Outlook.NameSpace
    Dim strSubject As String



    Private Sub ThisAddIn_Startup() Handles Me.Startup        

        objNamespace = Application.GetNamespace("MAPI")
        objCalFolder = objNamespace.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
        Dim objCalItems As Outlook.Items = objCalFolder.Items


        '******************************** Set Criteria for DELETION here ********************************
        strSubject = "Birthday"

        '************************************************************************************************

        'Get first appointment item   and store in 'appitem'
        Dim apptItem As Outlook.AppointmentItem = objCalItems.GetFirst

        'While appitem has appointments stored, if an appointment's subject contains "Birthday" delete it.
        Do While apptItem IsNot Nothing
            If apptItem.Subject.Contains(strSubject) Then
                apptItem.Delete()
                lngDeletedAppointements = lngDeletedAppointements + 1
            End If

            apptItem = objCalItems.GetNext
        Loop

        'Display Messagebox informing how many birthdays were deleted
        System.Windows.Forms.MessageBox.Show(lngDeletedAppointements.ToString + " Birthdays deleted.", "DELETE Birthdays")

        'Cleanup
        objNamespace = Nothing
        objCalFolder = Nothing
        objCalItems = Nothing
        apptItem = Nothing
        lngDeletedAppointements = Nothing
        strSubject = Nothing
    End Sub

我正在使用 Do While 循环进行删除过程,因为我已经读过使用 For Each 循环会导致集合中的索引变得混乱实际上只删除了集合中大约一半的项目(我也试过了)。 Do While 循环似乎提供了相同的结果。我很困惑!

提前感谢您的任何建议。我觉得这应该是如此简单,但当然它永远不会!我是一个非常新的插件开发,我仍然是一个非常初级的程序员。如果需要任何其他信息,请告诉我,我很乐意提供。

再次感谢!

2 个答案:

答案 0 :(得分:2)

你试过减少一个' For'循环,

For value as Integer = objCalItems.Count to 0 Step -1
    apptItem = objCalItems(value)

    If apptItem.Subject.Contains(strSubject) Then
        apptItem.Delete()
        lngDeletedAppointements = lngDeletedAppointements + 1
    Else
        Marshal.ReleaseComObject(apptItem)
    End If

我希望这有帮助。

答案 1 :(得分:1)

不是迭代文件夹中的所有项目,而是使用Items类的Find / FindNextRestrict方法来查找与您的条件对应的Outlook项目。例如,看看以下文章: