A
anovak
Friends,
I wrote a VBA script that reads values from the EPM Reporting
Database, presents a form, and then creates a "shell project" based on
what the user selects (to save time for developers).
I store this in an MPP file called SDLC.mpp which works perfectly each
time I run it within the open MPP. However, once I copy the module to
Enterprise Global (for other users to access), I receive this error
that seems to pertain to the database connection. "Dim Conn As New
ADODB.Connection" is highlighted in black and "Sub SDLC()" is
highlighted in yellow.
Any ideas? I'm very new to this, and was very excited to see it work
very well UNTIL I copied to Enterprise Global.
See Below.
Also, I assume all I have to do is copy the FORM used (along with its
code) via the MS Visual Basic editor to the checked-out enterprise
global from the MPP file (see very bottom)?
Thanks,
Andy Novak
UNT
******
Option Explicit
Sub SDLC()
'You need a reference to Microsoft ActiveX Data Objects 2.5
'or greater to let this code run
Dim Conn As New ADODB.Connection
Dim rs As ADODB.Recordset
'Create Connection to the .mdb file
Set Conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Conn.ConnectionString = "Provider=sqloledb;" _
& "Data Source=#####;" _
& "Initial Catalog=ProjectServer_Reporting;" _
& "Integrated Security=SSPI;"
Conn.Open
'Open Recordset with all Performers in
rs.Open "Select CAST(MemberFullValue as varchar(255)) AS
MemberValue,MemberDescription FROM MSPLT_Performer_UserView WHERE
(MemberValue <> '') ORDER BY MemberValue", Conn
Dim rs2 As ADODB.Recordset
'Create Connection to the .mdb file
Set rs2 = New ADODB.Recordset
'Open Recordset with all Service Areas in
rs2.Open "Select MemberValue FROM [MSPLT_Service Area_UserView]
WHERE (MemberValue <> '') ORDER BY MemberValue", Conn
Dim rs3 As ADODB.Recordset
'Create Connection to the .mdb file
Set rs3 = New ADODB.Recordset
'Open Recordset with all Institutions in
rs3.Open "Select MemberValue FROM [MSPLT_Institution_UserView]
WHERE (MemberValue <> '') ORDER BY MemberValue", Conn
Dim rs4 As ADODB.Recordset
'Create Connection to the .mdb file
Set rs4 = New ADODB.Recordset
'Open Recordset with all Institutions in
rs4.Open "Select MemberValue FROM [MSPLT_Project
Classification_UserView] WHERE (MemberValue <> '') ORDER BY
MemberValue", Conn
'Initialize Combo Boxes
Dim i As Integer
rs.MoveFirst
i = 0
With NewProject.TeamComboBox
.Clear
Do
.AddItem
.List(i, 0) = rs!MemberDescription
'.List(i, 1) = rs!MemberFullValue
.List(i, 1) = rs!MemberValue
i = i + 1
rs.MoveNext
Loop Until rs.EOF
End With
Do Until rs2.EOF
'Debug.Print rs2!MemberValue
NewProject.SvcAreaComboBox.AddItem (rs2!MemberValue)
rs2.MoveNext
Loop
Do Until rs3.EOF
'Debug.Print rs3!MemberValue
NewProject.InstitutionComboBox.AddItem (rs3!MemberValue)
rs3.MoveNext
Loop
Do Until rs4.EOF
'Debug.Print rs3!MemberValue
NewProject.ProjClassComboBox.AddItem (rs4!MemberValue)
rs4.MoveNext
Loop
'Display user form
NewProject.Show
'Open new sheet and set initial view
FileNew Template:=""
ViewApply Name:="_Pilot View"
'Get Enterprise Resources for the selected team
If NewProject.TeamComboBox <> "" Then
Dim rs5 As ADODB.Recordset
'Create Connection to the .mdb file
Set rs5 = New ADODB.Recordset
'Open Recordset with all enterprise resources in
rs5.Open "Select ResourceClientUniqueID FROM
[MSP_EpmResource_UserView]" & " WHERE RBS LIKE '%" &
NewProject.TeamComboBox.Column(1) & "%'", Conn
Do Until rs5.EOF
' Debug.Print rs4!ResourceClientUniqueID
EnterpriseResourceGet (rs5!ResourceClientUniqueID)
rs5.MoveNext
Loop
rs5.Close
End If
SetTaskField Field:="Name", Value:="Requirements", TaskID:=1
SetTaskField Field:="Name", Value:="Design", TaskID:=2
SetTaskField Field:="Name", Value:="Development", TaskID:=3
SetTaskField Field:="Name", Value:="Testing", TaskID:=4
SetTaskField Field:="Name", Value:="Deployment", TaskID:=5
SetTaskField Field:="Predecessors", Value:="1", TaskID:=2
SetTaskField Field:="Predecessors", Value:="2", TaskID:=3
SetTaskField Field:="Predecessors", Value:="3", TaskID:=4
SetTaskField Field:="Predecessors", Value:="4", TaskID:=5
SetTaskField Field:="Review Gate", Value:="Implementation",
TaskID:=1
SetTaskField Field:="Review Gate", Value:="Implementation",
TaskID:=2
SetTaskField Field:="Review Gate", Value:="Implementation",
TaskID:=3
SetTaskField Field:="Review Gate", Value:="Implementation",
TaskID:=4
SetTaskField Field:="Review Gate", Value:="Implementation",
TaskID:=5
OptionsSchedule EffortDriven:=False
OptionsSchedule ShowEstimated:=False, NewTasksEstimated:=False
OptionsViewEx ProjectSummary:=True
OptionsCalendar StartYearIn:=9
ProjectSummaryInfo Calendar:="UNT Standard"
If NewProject.TeamComboBox <> "" Then
ActiveProject.ProjectSummaryTask.SetField
FieldNameToFieldConstant("Performer"),
NewProject.TeamComboBox.Column(1)
End If
If NewProject.SvcAreaComboBox <> "" Then
ActiveProject.ProjectSummaryTask.SetField
FieldNameToFieldConstant("Service Area"), NewProject.SvcAreaComboBox
End If
If NewProject.InstitutionComboBox <> "" Then
ActiveProject.ProjectSummaryTask.SetField
FieldNameToFieldConstant("Institution"),
NewProject.InstitutionComboBox
End If
If NewProject.ProjClassComboBox <> "" Then
ActiveProject.ProjectSummaryTask.SetField
FieldNameToFieldConstant("Project Classification"),
NewProject.ProjClassComboBox
End If
SelectTaskField Row:=1, Column:="Work", RowRelative:=False
'Tidy up
rs.Close
rs2.Close
rs3.Close
rs4.Close
Conn.Close
End Sub
****
FORM CODE
***
Option Explicit
Private Sub UserForm_Initialize()
TeamComboBox = ""
SvcAreaComboBox = ""
InstitutionComboBox = "UNT"
ProjClassComboBox = "Small"
TeamComboBox.TabIndex = 0
SvcAreaComboBox.TabIndex = 1
InstitutionComboBox.TabIndex = 2
ProjClassComboBox.TabIndex = 3
End Sub
Private Sub RunMyMacro_Click()
NewProject.Hide
End Sub
I wrote a VBA script that reads values from the EPM Reporting
Database, presents a form, and then creates a "shell project" based on
what the user selects (to save time for developers).
I store this in an MPP file called SDLC.mpp which works perfectly each
time I run it within the open MPP. However, once I copy the module to
Enterprise Global (for other users to access), I receive this error
that seems to pertain to the database connection. "Dim Conn As New
ADODB.Connection" is highlighted in black and "Sub SDLC()" is
highlighted in yellow.
Any ideas? I'm very new to this, and was very excited to see it work
very well UNTIL I copied to Enterprise Global.
See Below.
Also, I assume all I have to do is copy the FORM used (along with its
code) via the MS Visual Basic editor to the checked-out enterprise
global from the MPP file (see very bottom)?
Thanks,
Andy Novak
UNT
******
Option Explicit
Sub SDLC()
'You need a reference to Microsoft ActiveX Data Objects 2.5
'or greater to let this code run
Dim Conn As New ADODB.Connection
Dim rs As ADODB.Recordset
'Create Connection to the .mdb file
Set Conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Conn.ConnectionString = "Provider=sqloledb;" _
& "Data Source=#####;" _
& "Initial Catalog=ProjectServer_Reporting;" _
& "Integrated Security=SSPI;"
Conn.Open
'Open Recordset with all Performers in
rs.Open "Select CAST(MemberFullValue as varchar(255)) AS
MemberValue,MemberDescription FROM MSPLT_Performer_UserView WHERE
(MemberValue <> '') ORDER BY MemberValue", Conn
Dim rs2 As ADODB.Recordset
'Create Connection to the .mdb file
Set rs2 = New ADODB.Recordset
'Open Recordset with all Service Areas in
rs2.Open "Select MemberValue FROM [MSPLT_Service Area_UserView]
WHERE (MemberValue <> '') ORDER BY MemberValue", Conn
Dim rs3 As ADODB.Recordset
'Create Connection to the .mdb file
Set rs3 = New ADODB.Recordset
'Open Recordset with all Institutions in
rs3.Open "Select MemberValue FROM [MSPLT_Institution_UserView]
WHERE (MemberValue <> '') ORDER BY MemberValue", Conn
Dim rs4 As ADODB.Recordset
'Create Connection to the .mdb file
Set rs4 = New ADODB.Recordset
'Open Recordset with all Institutions in
rs4.Open "Select MemberValue FROM [MSPLT_Project
Classification_UserView] WHERE (MemberValue <> '') ORDER BY
MemberValue", Conn
'Initialize Combo Boxes
Dim i As Integer
rs.MoveFirst
i = 0
With NewProject.TeamComboBox
.Clear
Do
.AddItem
.List(i, 0) = rs!MemberDescription
'.List(i, 1) = rs!MemberFullValue
.List(i, 1) = rs!MemberValue
i = i + 1
rs.MoveNext
Loop Until rs.EOF
End With
Do Until rs2.EOF
'Debug.Print rs2!MemberValue
NewProject.SvcAreaComboBox.AddItem (rs2!MemberValue)
rs2.MoveNext
Loop
Do Until rs3.EOF
'Debug.Print rs3!MemberValue
NewProject.InstitutionComboBox.AddItem (rs3!MemberValue)
rs3.MoveNext
Loop
Do Until rs4.EOF
'Debug.Print rs3!MemberValue
NewProject.ProjClassComboBox.AddItem (rs4!MemberValue)
rs4.MoveNext
Loop
'Display user form
NewProject.Show
'Open new sheet and set initial view
FileNew Template:=""
ViewApply Name:="_Pilot View"
'Get Enterprise Resources for the selected team
If NewProject.TeamComboBox <> "" Then
Dim rs5 As ADODB.Recordset
'Create Connection to the .mdb file
Set rs5 = New ADODB.Recordset
'Open Recordset with all enterprise resources in
rs5.Open "Select ResourceClientUniqueID FROM
[MSP_EpmResource_UserView]" & " WHERE RBS LIKE '%" &
NewProject.TeamComboBox.Column(1) & "%'", Conn
Do Until rs5.EOF
' Debug.Print rs4!ResourceClientUniqueID
EnterpriseResourceGet (rs5!ResourceClientUniqueID)
rs5.MoveNext
Loop
rs5.Close
End If
SetTaskField Field:="Name", Value:="Requirements", TaskID:=1
SetTaskField Field:="Name", Value:="Design", TaskID:=2
SetTaskField Field:="Name", Value:="Development", TaskID:=3
SetTaskField Field:="Name", Value:="Testing", TaskID:=4
SetTaskField Field:="Name", Value:="Deployment", TaskID:=5
SetTaskField Field:="Predecessors", Value:="1", TaskID:=2
SetTaskField Field:="Predecessors", Value:="2", TaskID:=3
SetTaskField Field:="Predecessors", Value:="3", TaskID:=4
SetTaskField Field:="Predecessors", Value:="4", TaskID:=5
SetTaskField Field:="Review Gate", Value:="Implementation",
TaskID:=1
SetTaskField Field:="Review Gate", Value:="Implementation",
TaskID:=2
SetTaskField Field:="Review Gate", Value:="Implementation",
TaskID:=3
SetTaskField Field:="Review Gate", Value:="Implementation",
TaskID:=4
SetTaskField Field:="Review Gate", Value:="Implementation",
TaskID:=5
OptionsSchedule EffortDriven:=False
OptionsSchedule ShowEstimated:=False, NewTasksEstimated:=False
OptionsViewEx ProjectSummary:=True
OptionsCalendar StartYearIn:=9
ProjectSummaryInfo Calendar:="UNT Standard"
If NewProject.TeamComboBox <> "" Then
ActiveProject.ProjectSummaryTask.SetField
FieldNameToFieldConstant("Performer"),
NewProject.TeamComboBox.Column(1)
End If
If NewProject.SvcAreaComboBox <> "" Then
ActiveProject.ProjectSummaryTask.SetField
FieldNameToFieldConstant("Service Area"), NewProject.SvcAreaComboBox
End If
If NewProject.InstitutionComboBox <> "" Then
ActiveProject.ProjectSummaryTask.SetField
FieldNameToFieldConstant("Institution"),
NewProject.InstitutionComboBox
End If
If NewProject.ProjClassComboBox <> "" Then
ActiveProject.ProjectSummaryTask.SetField
FieldNameToFieldConstant("Project Classification"),
NewProject.ProjClassComboBox
End If
SelectTaskField Row:=1, Column:="Work", RowRelative:=False
'Tidy up
rs.Close
rs2.Close
rs3.Close
rs4.Close
Conn.Close
End Sub
****
FORM CODE
***
Option Explicit
Private Sub UserForm_Initialize()
TeamComboBox = ""
SvcAreaComboBox = ""
InstitutionComboBox = "UNT"
ProjClassComboBox = "Small"
TeamComboBox.TabIndex = 0
SvcAreaComboBox.TabIndex = 1
InstitutionComboBox.TabIndex = 2
ProjClassComboBox.TabIndex = 3
End Sub
Private Sub RunMyMacro_Click()
NewProject.Hide
End Sub