Article ID: 187386
Article Last Modified on 1/23/2007
Sub SetPoolForConsolProjs()
Dim oTasks As Tasks
Dim oInsertedProj As Project
Dim i As Long
Dim sPoolName As String
Dim bCalcMode As Boolean
'Turn off calculation.
bCalcMode = Application.Calculation
Application.Calculation = pjManual
On Error GoTo SetPoolForConsolProjs
'Get tasks collection for consolidated project.
Set oTasks = ActiveProject.Tasks
cFile = ActiveProject.FullName
'*************************
'Create a new file and get name.
'This is where you tell the macro which file is going to
'be the resource pool. If you already have a resource
'pool, you can do something like:
'sPoolName = "c:\my documents\pool.mpp"
'The following two message boxes prompt you to save the file used for
'resource pool at the time you create it and then again when you are
'finished with your project.
MsgBox "Name your Resource Pool and click ""Save"" in the following " _
& "box" & Chr(13) & " When you finished save changes to all files."
Application.FileNew
Application.FileSaveAs
sPoolName = ActiveProject.FullName
'**************************
'Loop through all tasks and find inserted projects.
For i = 1 To oTasks.Count
If Not oTasks(i) Is Nothing Then
'Test for inserted projects.
If oTasks(i).SubProject <> "" Then
'Get ready to operate on subprojects.
'GetObject opens collapsed subprojects.
'Note: If the inserted projects are expanded, then this whole
'process runs much faster since the load and calculation
'process doesn't have to occur.
Set oInsertedProj = GetObject(oTasks(i).SubProject)
'Activate the inserted project. If this fails, then it
'means the inserted project isn't open in a window of
'its own. Therefore, use the NewWindow method.
On Error GoTo 0
On Error GoTo InsertProjectNotOpen
Projects("" & oInsertedProj & "").Activate
On Error GoTo 0
On Error GoTo SetPoolForConsolProjs
'Set the pool connection to the designated pool.
Application.ResourceSharing share:=True, Name:=sPoolName
'Close window.
Alerts False
FileClose pjDoNotSave, False
Alerts True
Set oInsertedProj = Nothing
End If
End If
Next i
'Reactivate the master project.
'Projects("" & oTasks.Parent & "").Activate
' Set the pool connection for the consolidated project to the
' designated pool
Projects(cFile).Activate
Application.ResourceSharing share:=True, Name:=sPoolName
Application.Calculation = bCalcMode
Exit Sub
SetPoolForConsolProjs:
Application.Calculation = bCalcMode
Exit Sub
InsertProjectNotOpen:
WindowNewWindow "" & oInsertedProj & ""
Resume
End Sub
120802 Office: How to Add/Remove a Single Office Program or Component
163435 VBA: Programming Resources for Visual Basic for Applications
Additional query words: prj2000 resource sharing
Keywords: kbdtacode kbinfo KB187386