CODEWITHSUNDEEP
vbams-project
peetman
peetman

Reputation: 707

Pop up Project Status Date form through VBA

What's the VBA code to popup the Status Date form in Project 2016? Just like if click the button on the ribbon. I want the code to pop up the Status Date and then keep running the macro.

Upvotes: 2

Views: 878

Answers (3)

peetman
peetman

Reputation: 707

Found the answer I needed.

ActiveProject.CommandBars.ExecuteMso ("StatusDate")

Upvotes: 0

Rachel Hettinger
Rachel Hettinger

Reputation: 8442

While you can just pop-up the Project Information Tab with this line: Application.ProjectSummaryInfo, you don't have any ability to validate the Status Date. There's nothing to stop the user from just clicking OK or Cancel without entering a date.

It's better to call a function like this so you know that a valid status date was entered. 

Private Sub GetStatusDate()

    Dim CurStatusDate As Variant
    CurStatusDate = ActiveProject.StatusDate

    ' set a default, suggested status date
    Dim SuggestedDate As Date
    SuggestedDate = Date

    Dim StatusDate As Date

    If VarType(CurStatusDate) = vbDate And CDate(CurStatusDate) >= SuggestedDate Then
        StatusDate = CDate(CurStatusDate)
    Else
        Dim Msg As String
        Msg = vbCrLf & "Suggested status date:" & vbTab & SuggestedDate
        If VarType(CurStatusDate) = vbDate Then
            Msg = "Current status date:" & vbTab & Format(CurStatusDate, "m/d/yyyy") & Msg
        Else
            Msg = "Current status date:" & vbTab & Format(CurStatusDate, "m/d/yyyy") & Msg
        End If

        Dim NewDate As String
        NewDate = InputBox(Msg, "Enter the project status date", SuggestedDate)

        If Len(NewDate) = 0 Then
            StatusDate = SuggestedDate
        ElseIf Not IsDate(NewDate) Then
            StatusDate = SuggestedDate
            Msg = "Your entry of " & NewDate & " was not recognized as a valid date." & _
                vbCrLf & StatusDate & " will be used as the status date."
            MsgBox Msg, vbOKOnly + vbCritical, "Invalid entry"
        Else
            StatusDate = CDate(NewDate)
        End If
        ActiveProject.StatusDate = StatusDate
    End If

End Sub

Upvotes: 0

Dave
Dave

Reputation: 4356

Dim NewStatusDate
NewStatusDate = InputBox("Please enter a new Status Date value")
If NewStatusDate <> "" Then ' Check it's not empty
    ThisProject.StatusDate = NewStatusDate
End If

You'd probably want to validate that the value given was a date and any other things you might require but this will pop up an inputbox and allow you to change the Status Date for the project.

Upvotes: 1

Related Questions