none
How to read the resources calendar exceptions with VBA

    Pertanyaan

  • Hello,

    How can I read the resources Calendar.Exceptions and their subject label ?

    Thanks for your help


    Gérard Ducouret [Project MVP], Certifié Project 70632, Certifié ITIL

    Senin, 03 September 2018 14.15

Jawaban

  • Gerard,

    Nice to see you in the forum again. Here is one way to get the exceptions.

    Hope it helps.

    John

    Option Explicit
    Sub CalendarExceptions()
    'Basic macro code created by Kiran.K and posted on MSDN Project
    ' customizing and programming forum Feb 7,2013
    'Code streamlined and updated by John - Project June 2,2014
    'Modified to pick up exceptions for all base calendars in a given Project file by John - Project Feb 8, 2016

    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    Dim i As Integer, j As Integer
    Dim BC As Calendar
    Dim E As Exception
    Dim r As Resource
    Dim xlRng As Range

    'open Excel, define workbook, and set column headers
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "Exception Report"
    MyXL.ActiveWorkbook.Worksheets("Exception Report").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")
    xlRng.Range("A1") = "Proj Cal Holidays"
    xlRng.Range("B1") = "Base Calendar"
    xlRng.Range("C1") = "Start Date"
    xlRng.Range("D1") = "Finish Date"
    xlRng.Range("F1") = "Res Name"
    xlRng.Range("G1") = "Res Base Cal"
    xlRng.Range("H1") = "Base Cal Excep"
    xlRng.Range("I1") = "Start Date"
    xlRng.Range("J1") = "Finish Date"
    xlRng.Range("L1") = "Resource Name"
    xlRng.Range("M1") = "Res Excep"
    xlRng.Range("N1") = "Start Date"
    xlRng.Range("O1") = "Finish Date"

    'First gather and export Project calendar exceptions
    For Each BC In ActiveProject.BaseCalendars

    i = 2
    If BC.Exceptions.count > 0 Then
        For Each E In BC.Exceptions
            xlRng.Range("A" & i) = E.Name
            xlRng.Range("B" & i) = BC.Name
            xlRng.Range("C" & i) = E.Start
            xlRng.Range("D" & i) = E.Finish
            i = i + 1
        Next
    End If

    'Next, gather and export resource base calendar exceptions along with
    '   resource calendar exceptions
    i = 2
    For Each r In ActiveProject.Resources
        If Not r Is Nothing Then
            j = i
            If r.Type = pjResourceTypeWork Then
                    For Each E In r.Calendar.BaseCalendar.Exceptions
                        xlRng.Range("F" & i) = r.Name
                        xlRng.Range("G" & i) = r.Calendar.BaseCalendar.Name
                        xlRng.Range("H" & i) = E.Name
                        xlRng.Range("I" & i) = E.Start
                        xlRng.Range("J" & i) = E.Finish
                        i = i + 1
                    Next E
                    For Each E In r.Calendar.Exceptions
                        xlRng.Range("L" & j) = r.Name
                        xlRng.Range("M" & j) = E.Name
                        xlRng.Range("N" & j) = E.Start
                        xlRng.Range("O" & j) = E.Finish
                        j = j + 1
                    Next E
            End If
        End If
    Next r
    MyXL.ActiveWorkbook.Worksheets("Exception Report").Columns("A:N").AutoFit
    End Sub

    Sub BaseCalendarExceptions()
    'This macro exports the exceptions for all base calendars in a given Project file
    '(modified version of the CalendarExceptions macro published previously in this forum)
    ' Written by John - Project 2/8/16
    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    Dim i As Integer, j As Integer
    Dim BC As Calendar
    Dim E As Exception
    Dim xlRng As Range

    'open Excel, define workbook, and set column headers
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "BaseCal Exc Report"
    MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")
    xlRng.Range("A1") = "Proj Cal Holidays"
    xlRng.Range("B1") = "Base Calendar"
    xlRng.Range("C1") = "Start Date"
    xlRng.Range("D1") = "Finish Date"

    'Gather and export Project calendar exceptions
    j = 0
    For Each BC In ActiveProject.BaseCalendars
        i = 2 + j
        If BC.Exceptions.count > 0 Then
            For Each E In BC.Exceptions
                xlRng.Range("A" & i) = E.Name
                xlRng.Range("B" & i) = BC.Name
                xlRng.Range("C" & i) = E.Start
                xlRng.Range("D" & i) = E.Finish
                i = i + 1
            Next E
        End If
        j = i
    Next BC
    MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Columns("A:D").AutoFit

    End Sub

    Senin, 03 September 2018 14.29

Semua Balasan

  • Gerard,

    Nice to see you in the forum again. Here is one way to get the exceptions.

    Hope it helps.

    John

    Option Explicit
    Sub CalendarExceptions()
    'Basic macro code created by Kiran.K and posted on MSDN Project
    ' customizing and programming forum Feb 7,2013
    'Code streamlined and updated by John - Project June 2,2014
    'Modified to pick up exceptions for all base calendars in a given Project file by John - Project Feb 8, 2016

    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    Dim i As Integer, j As Integer
    Dim BC As Calendar
    Dim E As Exception
    Dim r As Resource
    Dim xlRng As Range

    'open Excel, define workbook, and set column headers
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "Exception Report"
    MyXL.ActiveWorkbook.Worksheets("Exception Report").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")
    xlRng.Range("A1") = "Proj Cal Holidays"
    xlRng.Range("B1") = "Base Calendar"
    xlRng.Range("C1") = "Start Date"
    xlRng.Range("D1") = "Finish Date"
    xlRng.Range("F1") = "Res Name"
    xlRng.Range("G1") = "Res Base Cal"
    xlRng.Range("H1") = "Base Cal Excep"
    xlRng.Range("I1") = "Start Date"
    xlRng.Range("J1") = "Finish Date"
    xlRng.Range("L1") = "Resource Name"
    xlRng.Range("M1") = "Res Excep"
    xlRng.Range("N1") = "Start Date"
    xlRng.Range("O1") = "Finish Date"

    'First gather and export Project calendar exceptions
    For Each BC In ActiveProject.BaseCalendars

    i = 2
    If BC.Exceptions.count > 0 Then
        For Each E In BC.Exceptions
            xlRng.Range("A" & i) = E.Name
            xlRng.Range("B" & i) = BC.Name
            xlRng.Range("C" & i) = E.Start
            xlRng.Range("D" & i) = E.Finish
            i = i + 1
        Next
    End If

    'Next, gather and export resource base calendar exceptions along with
    '   resource calendar exceptions
    i = 2
    For Each r In ActiveProject.Resources
        If Not r Is Nothing Then
            j = i
            If r.Type = pjResourceTypeWork Then
                    For Each E In r.Calendar.BaseCalendar.Exceptions
                        xlRng.Range("F" & i) = r.Name
                        xlRng.Range("G" & i) = r.Calendar.BaseCalendar.Name
                        xlRng.Range("H" & i) = E.Name
                        xlRng.Range("I" & i) = E.Start
                        xlRng.Range("J" & i) = E.Finish
                        i = i + 1
                    Next E
                    For Each E In r.Calendar.Exceptions
                        xlRng.Range("L" & j) = r.Name
                        xlRng.Range("M" & j) = E.Name
                        xlRng.Range("N" & j) = E.Start
                        xlRng.Range("O" & j) = E.Finish
                        j = j + 1
                    Next E
            End If
        End If
    Next r
    MyXL.ActiveWorkbook.Worksheets("Exception Report").Columns("A:N").AutoFit
    End Sub

    Sub BaseCalendarExceptions()
    'This macro exports the exceptions for all base calendars in a given Project file
    '(modified version of the CalendarExceptions macro published previously in this forum)
    ' Written by John - Project 2/8/16
    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    Dim i As Integer, j As Integer
    Dim BC As Calendar
    Dim E As Exception
    Dim xlRng As Range

    'open Excel, define workbook, and set column headers
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "BaseCal Exc Report"
    MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")
    xlRng.Range("A1") = "Proj Cal Holidays"
    xlRng.Range("B1") = "Base Calendar"
    xlRng.Range("C1") = "Start Date"
    xlRng.Range("D1") = "Finish Date"

    'Gather and export Project calendar exceptions
    j = 0
    For Each BC In ActiveProject.BaseCalendars
        i = 2 + j
        If BC.Exceptions.count > 0 Then
            For Each E In BC.Exceptions
                xlRng.Range("A" & i) = E.Name
                xlRng.Range("B" & i) = BC.Name
                xlRng.Range("C" & i) = E.Start
                xlRng.Range("D" & i) = E.Finish
                i = i + 1
            Next E
        End If
        j = i
    Next BC
    MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Columns("A:D").AutoFit

    End Sub

    Senin, 03 September 2018 14.29
  • Thanks a lot John, for this detailed answer.

    Nice to meet you again in this forum.

    Gérard


    Gérard Ducouret [Project MVP], Certifié Project 70632, Certifié ITIL

    Rabu, 05 September 2018 17.25