How to Update a Microsoft Project Sub-Project Using VBA - vba

Question

We are attempting to update the status date in the sub-projects of a Schedule using VBA following the suggestions here and here. Ideally we'd like to keep the files closed while doing so, but are open to suggestions if that isn't strictly possible.
The relevant code looks like this:
If ActiveProject.Subprojects.count > 0 Then
Dim msg: msg = MsgBox("Change Status Date for unopened Subprojects?", vbYesNo, "Change Status Dates for Unopened Subprojects?")
Dim subp As SubProject
If msg = vbYes Then
Application.StatusBar = "Updating Sub-Projects..."
For Each subp In ActiveProject.Subprojects
subp.SourceProject.StatusDate = newDate
subp.SourceProject.SaveAs subp.SourceProject.Name
Next
End If
End If
This appears to work, however when we open the sub-project files the Status Date hasn't changed (as seen on Project > Status > Status Date). The date below is the same before and after:
Alternatives that also have not worked.
We've tried setting Projects(subp.SourceProject.Name).StatusDate:
If ActiveProject.Subprojects.count > 0 Then
Dim msg: msg = MsgBox("Change Status Date for unopened Subprojects?", vbYesNo, "Change Status Dates for Unopened Subprojects?")
Dim subp As SubProject
If msg = vbYes Then
Application.StatusBar = "Updating Sub-Projects..."
For Each subp In ActiveProject.Subprojects
Projects(subp.SourceProject.Name).StatusDate = newDate
subp.SourceProject.SaveAs subp.SourceProject.Name
Next
End If
End If
We've tried to open the sub-projects first and then to change the value (we've tried both FileOpen & FileOpenEx):
If ActiveProject.Subprojects.count > 0 Then
Dim msg: msg = MsgBox("Change Status Date for unopened Subprojects?", vbYesNo, "Change Status Dates for Unopened Subprojects?")
Dim subp As SubProject
If msg = vbYes Then
Application.StatusBar = "Updating Sub-Projects..."
For Each subp In ActiveProject.Subprojects
FileOpen subp.SourceProject.Path
subp.SourceProject.StatusDate = newDate
FileClose pjSave
Next
End If
End If
And then we've tried saving the sub-projects in various ways using:
subp.SourceProject.SaveAs subp.SourceProject.Name
Projects(subp.SourceProject.path).SaveAs subp.SourceProject.Name
As an interesting data point, we do notice that both the SourceProject.StatusDate and Projects(subp.SourceProject.Name).StatusDate for a given sub-project are what we set them to, even if the sub-project, once opened in MSP, does not reflect the value in the interface.
Note: we have tried closing/re-opening and manual save all (user input). No go.
Any suggestions are more than welcome.
EDIT #1
Note that we have also attempted saving the master schedule following the loop using two methods.
First, code leading up to the save:
'save name of Master Schedule to imsProj
dim imsProj as string: imsProj = ActiveProj.Name
If ActiveProject.Subprojects.count > 0 Then
'Here is where we run the above loop
End If
'Ensure the Master Schedule is the active project
Projects(imsProj).Activate
'Master Schedule save goes here. See below.
Then:
Save Method 1
'Save all open Projects, including master
For i = 1 To Projects.count
Projects(i).SaveAs Projects(i).Name
Next i
Save Method 2:
FileSave
Neither works.
Is there a setting in MSP that we are not considering?

Answer 1

Instead of trying to save each subproject individually, save the entire master at the end. Turning of alerts prevents a pop-up confirmation box for each subproject.
Sub SetSubProjectStatusDate()
Dim newDate As Date
newDate = #1/11/2022#
If ActiveProject.Subprojects.Count > 0 Then
Dim msg As VbMsgBoxResult
msg = MsgBox("Change Status Date for unopened Subprojects?", vbYesNo + vbQuestion _
, "Change Status Dates?")
If msg = vbYes Then
Application.StatusBar = "Updating Sub-Projects..."
Dim subp As Subproject
For Each subp In ActiveProject.Subprojects
subp.SourceProject.StatusDate = newDate
Next
DisplayAlerts = False
FileSave
DisplayAlerts = True
End If
End If
End Sub

Answer 2

This is incredibly frustrating, but it appears the IMS and its subprojects were somehow corrupted. No evident cause, no evident effect other than with how the status dates appear. Using a fresh set of MPPs resolved the matter.
Here is the final working code:
If ActiveProject.Subprojects.count > 0 Then
Dim msg: msg = MsgBox("Change Status Date for unopened Subprojects?", vbYesNo, "Change Status Dates for Unopened Subprojects?")
Dim subp As SubProject
If msg = vbYes Then
Application.StatusBar = "Updating Sub-Projects..."
For Each subp In ActiveProject.Subprojects
subp.SourceProject.StatusDate = temp
Next
End If
End If
Projects(imsProj).Activate
FileSave