VBA Compile Error: User-Defined Type Not Defined-Please Help : )

A

andy.novak

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
 
R

Rod Gill

Hi,

I think you need to open the module from the EGlobal file and set the
reference there to the oledb driver. Compile to confirm success.

--

Rod Gill
Microsoft MVP for Project

Author of the only book on Project VBA, see:
http://www.projectvbabook.com



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
 
A

andy.novak

Hi,

I think you need to open the module from the EGlobal file and set the
reference there to the oledb driver. Compile to confirm success.

--

Rod Gill
Microsoft MVP for Project

Author of the only book on Project VBA, see:http://www.projectvbabook.com


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
Private Sub RunMyMacro_Click()
   NewProject.Hide

Rod,
Do you mean change each occurence of "ADODB" to "OLEDB"
in the module within EGlobal?
Thanks
Andy
 
A

andy.novak

Hi,

I think you need to open the module from the EGlobal file and set the
reference there to the oledb driver. Compile to confirm success.

--

Rod Gill
Microsoft MVP for Project

Author of the only book on Project VBA, see:http://www.projectvbabook.com


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
Private Sub RunMyMacro_Click()
   NewProject.Hide

Rod, it appears that an oledb driver is already being referenced
(Provider=sqloledb).
Should the Provider reference a different string?

Sorry, I'm very very new at this and will need a bit more information
to "get it".

Thanks,
Andy

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
 
R

Rod Gill

Yes, sorry. You need a reference to the latest MDAC (should be 2.8) in your
PC. Sometimes when copying modules to the Global.mpt I find the reference
doesn't get copied!

--

Rod Gill
Microsoft MVP for Project

Author of the only book on Project VBA, see:
http://www.projectvbabook.com



Hi,

I think you need to open the module from the EGlobal file and set the
reference there to the oledb driver. Compile to confirm success.

--

Rod Gill
Microsoft MVP for Project

Author of the only book on Project VBA, see:http://www.projectvbabook.com


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
Private Sub RunMyMacro_Click()

End Sub

Rod, it appears that an oledb driver is already being referenced
(Provider=sqloledb).
Should the Provider reference a different string?

Sorry, I'm very very new at this and will need a bit more information
to "get it".

Thanks,
Andy

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
 
A

andy.novak

Yes, sorry. You need a reference to the latest MDAC (should be 2.8) in your
PC. Sometimes when copying modules to the Global.mpt I find the reference
doesn't get copied!

--

Rod Gill
Microsoft MVP for Project

Author of the only book on Project VBA, see:http://www.projectvbabook.com


I think you need to open the module from the EGlobal file and set the
reference there to the oledb driver. Compile to confirm success.

Rod Gill
Microsoft MVP for Project
Author of the only book on Project VBA, see:http://www.projectvbabook.com
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

Rod, it appears that an oledb driver is already being referenced
(Provider=sqloledb).
Should the Provider reference a different string?

Sorry, I'm very very new at this and will need a bit more information
to "get it".

Thanks,
Andy

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

Rod, I'm sorry but I don't know where to start on that. Could you
please be specific as to how I would accomplish this task?

Thanks,
Andy
 
A

andy.novak

Yes, sorry. You need a reference to the latest MDAC (should be 2.8) in your
PC. Sometimes when copying modules to the Global.mpt I find the reference
doesn't get copied!

--

Rod Gill
Microsoft MVP for Project

Author of the only book on Project VBA, see:http://www.projectvbabook.com


I think you need to open the module from the EGlobal file and set the
reference there to the oledb driver. Compile to confirm success.

Rod Gill
Microsoft MVP for Project
Author of the only book on Project VBA, see:http://www.projectvbabook.com
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

Rod, it appears that an oledb driver is already being referenced
(Provider=sqloledb).
Should the Provider reference a different string?

Sorry, I'm very very new at this and will need a bit more information
to "get it".

Thanks,
Andy

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

By PC, are you talking about my physical workstation? I'm wanting
this to be a global macro that everyone can run.
Sorry, I'm going to need a little guidance on this. Is this
referenced in your book somewhere?
 
R

Rod Gill

On your PC, open the Global file then open the macro from the global file in
the VBEW. Now set the relevant reference in the VBE. Compile, save and close
the global file.

--

Rod Gill
Microsoft MVP for Project

Author of the only book on Project VBA, see:
http://www.projectvbabook.com



Yes, sorry. You need a reference to the latest MDAC (should be 2.8) in
your
PC. Sometimes when copying modules to the Global.mpt I find the reference
doesn't get copied!

--

Rod Gill
Microsoft MVP for Project

Author of the only book on Project VBA, see:http://www.projectvbabook.com


I think you need to open the module from the EGlobal file and set the
reference there to the oledb driver. Compile to confirm success.

Rod Gill
Microsoft MVP for Project
Author of the only book on Project VBA,
see:http://www.projectvbabook.com
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

Rod, it appears that an oledb driver is already being referenced
(Provider=sqloledb).
Should the Provider reference a different string?

Sorry, I'm very very new at this and will need a bit more information
to "get it".

Thanks,
Andy

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

By PC, are you talking about my physical workstation? I'm wanting
this to be a global macro that everyone can run.
Sorry, I'm going to need a little guidance on this. Is this
referenced in your book somewhere?
 
A

andy.novak

On your PC, open the Global file then open the macro from the global filein
the VBEW. Now set the relevant reference in the VBE. Compile, save and close
the global file.

--

Rod Gill
Microsoft MVP for Project

Author of the only book on Project VBA, see:http://www.projectvbabook.com


Yes, sorry. You need a reference to the latest MDAC (should be 2.8) in
your
PC. Sometimes when copying modules to the Global.mpt I find the reference
doesn't get copied!

Rod Gill
Microsoft MVP for Project
Author of the only book on Project VBA, see:http://www.projectvbabook.com
"(e-mail address removed)" <[email protected]> wrote in message
On Nov 5, 2:05 am, "Rod Gill" <rodATproject-systemsDOTcoDOTnz> wrote:
Hi,
I think you need to open the module from the EGlobal file and set the
reference there to the oledb driver. Compile to confirm success.
--
Rod Gill
Microsoft MVP for Project
Author of the only book on Project VBA,
see:http://www.projectvbabook.com

Friends,
I wrote a VBA script that reads values from the EPM Reporting
Database, presents a form, and then creates a "shell project" basedon
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
Rod, it appears that an oledb driver is already being referenced
(Provider=sqloledb).
Should the Provider reference a different string?
Sorry, I'm very very new at this and will need a bit more information
to "get it".

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

By PC, are you talking about my physical workstation?   I'm wanting
this to be a global macro that everyone can run.
Sorry, I'm going to need a little guidance on this.    Is this
referenced in your book somewhere?

Rod, I finally found how to set the reference (under Tools in the VB
Editor). Here's the deal...

It worked from within EGLOBAL -- for me only.

When I had an end user invoke the macro, they received a run-time
error ' -2147217843 (80040e4d) Login failed AD\xxxxxxx"

What I'm guessing is that you have to have Administrator priviledges
to run this code, correct?

Here's my followup ?

How do I embed a login string in the code and somehow either encrypt
the password or create an executable of the VBA or remove access to
the source so that when the end user happens to see the code, they
won't see the password? And, I don't want to give Administrator
priviledges to all PMs.

Thanks in advance for the tip!! :)

Andy Novak
UNT
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top