none
MS Project 2007 - Calendar Exceptions - How to delete a calendar exception with VBA code? RRS feed

  • Question

  • I am working on various programmes developed by third party.
    Quite often the calendars have incorrect exceptions.
    How can I remove all exceptions at once without checking whether there are any, and them create new onces?

    So far:

    TO DELETE AN EXCEPTION:

    Sub Delete_Exception ()
    Dim cal As Calendar
    Dim CalName As String
    CalName = ActiveProject.Calendar.Name
    ActiveProject.BaseCalendars(calName).Exceptions(1).Delete
    End Sub

    TO CREATE EXCEPTION:

    Sub Create_Exception ()
    Dim cal As Calendar
    Dim CalName As String
    CalName = ActiveProject.Calendar.Name
    ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="22/03/2011", Finish:="22/04/2011", Name:="2013 Good Friday"
    End Sub

    The creation code works fine.
    I have trouble with the deleting as it only works with one line.
    how can I make it:
    - first detect whether there is any exception in place
    - secondly loop it in order to delete all data

    Anybody, please? 


    Thursday, August 15, 2013 12:04 PM

Answers

  • Tomasz,

    This will do it:

    Sub delCalExc()
    Dim e As Exception
    Dim CalNam As String
    CalNam = ActiveProject.Calendar.Name
    For Each e In ActiveProject.BaseCalendars(CalNam).Exceptions
        e.Delete
    Next e
    End Sub

    Note: if there are no exceptions the loop will just fall through

    John


    Thursday, August 15, 2013 2:54 PM
  • John,

    Thank you very much! My script saves me a lot of time now as I can refrain from checking the exceptions just by replacing them with correct once instead. My final script is:

    Sub Add_Company_Calendar_Exceptions()

    Delete_All_Existing_Exceptions
    Create_New_Exceptions
    End_Note

    End Sub

    Private Sub Delete_All_Existing_Exceptions()

    Dim e As Exception
    Dim CalName As String

    CalName = ActiveProject.Calendar.Name
    For Each e In ActiveProject.BaseCalendars(CalName).Exceptions
        e.Delete
    Next e

    End Sub

    Private Sub Create_New_Exceptions()

    Dim e As Exception
    Dim cal As Calendar
    Dim CalName As String

    CalName = ActiveProject.Calendar.Name

    '2010 NON WORKING DAYS
        ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="02/04/2010", Finish:="02/04/2010", Name:="2010 Good Friday"
        ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="05/04/2010", Finish:="05/04/2010", Name:="2010 Easter Monday"
        ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="03/05/2010", Finish:="03/05/2010", Name:="2010 Early May Bank Holiday"
        ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="31/05/2010", Finish:="31/05/2010", Name:="2010 Spring Bank Holiday"
        ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="30/08/2010", Finish:="30/08/2010", Name:="2010 Summer Bank Holiday"
        ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="20/12/2010", Finish:="31/12/2010", Name:="2010 Christmas Shutdown"

    End Sub

    Private Sub End_Note()

    Msg = "Congratulations " & Application.UserName & " !!!" & Chr(10) & "Project Calendar has been successfully updated!" & Chr(10) & "Add more exceptions if required."
    MsgBox Msg, vbExclamation, Title:="Company - prepared by Tomasz Baczynski"

    End Sub

    Tuesday, August 27, 2013 12:44 PM

All replies

  • Tomasz,

    This will do it:

    Sub delCalExc()
    Dim e As Exception
    Dim CalNam As String
    CalNam = ActiveProject.Calendar.Name
    For Each e In ActiveProject.BaseCalendars(CalNam).Exceptions
        e.Delete
    Next e
    End Sub

    Note: if there are no exceptions the loop will just fall through

    John


    Thursday, August 15, 2013 2:54 PM
  • John,

    Thank you very much! My script saves me a lot of time now as I can refrain from checking the exceptions just by replacing them with correct once instead. My final script is:

    Sub Add_Company_Calendar_Exceptions()

    Delete_All_Existing_Exceptions
    Create_New_Exceptions
    End_Note

    End Sub

    Private Sub Delete_All_Existing_Exceptions()

    Dim e As Exception
    Dim CalName As String

    CalName = ActiveProject.Calendar.Name
    For Each e In ActiveProject.BaseCalendars(CalName).Exceptions
        e.Delete
    Next e

    End Sub

    Private Sub Create_New_Exceptions()

    Dim e As Exception
    Dim cal As Calendar
    Dim CalName As String

    CalName = ActiveProject.Calendar.Name

    '2010 NON WORKING DAYS
        ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="02/04/2010", Finish:="02/04/2010", Name:="2010 Good Friday"
        ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="05/04/2010", Finish:="05/04/2010", Name:="2010 Easter Monday"
        ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="03/05/2010", Finish:="03/05/2010", Name:="2010 Early May Bank Holiday"
        ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="31/05/2010", Finish:="31/05/2010", Name:="2010 Spring Bank Holiday"
        ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="30/08/2010", Finish:="30/08/2010", Name:="2010 Summer Bank Holiday"
        ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="20/12/2010", Finish:="31/12/2010", Name:="2010 Christmas Shutdown"

    End Sub

    Private Sub End_Note()

    Msg = "Congratulations " & Application.UserName & " !!!" & Chr(10) & "Project Calendar has been successfully updated!" & Chr(10) & "Add more exceptions if required."
    MsgBox Msg, vbExclamation, Title:="Company - prepared by Tomasz Baczynski"

    End Sub

    Tuesday, August 27, 2013 12:44 PM
  • Tomasz,

    You're welcome and thanks for the feedback.

    It sounds like your question was answered. If so, please mark it as answered.

    John


    Tuesday, August 27, 2013 3:33 PM