vbams-project

The amount of possible working hours between two dates in MS Project using VBA


Is it possible to return the amount of possible working hours between a start and finish time in MS Project using VBA? For example if the start and end time was from 12pm to 5pm in the same day and there was a lunch break from 12:30p to 1:30pm than the value returned would be 4 hours (instead of the total time passed of 5 hours).

EDIT: Also can you count the total number of shifts (breaks) in a day using VBA?


Solution

  • Question #1: Calculate working hours between two dates

    The Microsoft Project application object has a method called DateDifference which does just that--it calculates the working time between two dates and you can optionally supply a calendar object (the project calendar is used by default). The return value is in minutes, so divide by 60 to get hours.

    Use the Intermediate Window* to test:

    ? Application.DateDifference (#3/11/19 12:00 PM#, #3/11/19 5:00 PM#) / 60
     4 
    ? Application.DateDifference (#3/11/19 12:00 PM#, #3/11/19 5:00 PM#, ActiveProject.BaseCalendars("24 Hours")) / 60
    5
    

    Note: The optional Calendar argument is a calendar object, not the name of a calendar and it must be a calendar in use by the active project.

    * From the VB Editor, do Ctrl+G to bring up the Intermediate Window.

    Question #2: Calculate the number of shifts for a given day

    This function will return the number of shifts for a given day for a particular calendar. If no calendar name is supplied, the project calendar is used.

    It works by using the fact that booleans can be converted to integers (False = 0, True = -1) to count the number of true expressions. Specifically, if a shift is used, the Start time is returned as a string representation (e.g. "8:00 AM"), but if the shift is not used, it is returned as an integer (0).

    Function ShiftCount(d As Date, Optional calendarName As Variant)
    
        Dim c As Calendar
        If IsMissing(calendarName) Then
            Set c = ActiveProject.Calendar
        Else
            Set c = ActiveProject.BaseCalendars(calendarName)
        End If
    
        Dim NumShifts As Integer
        With c.Period(d)
            NumShifts = -CInt(VarType(.Shift1.Start) = vbString) _
                       - CInt(VarType(.Shift2.Start) = vbString) _
                       - CInt(VarType(.Shift3.Start) = vbString) _
                       - CInt(VarType(.Shift4.Start) = vbString) _
                       - CInt(VarType(.Shift5.Start) = vbString)
        End With
    
        ShiftCount = NumShifts
    
    End Function