How to query project server DB from VBA in Project Professional

[AaronD]

Greetings,

I'm looking for an example how to query the project server database
from within Project Professional using VBA.

My ultimate goal is to retrieve the full list of enterprise resources
from the server, and then to programmatically add selected resources
to the project.

Other users have suggested the necessary queries to use to retrieve
the list of resource from the reporting database.

Unfortunately, I have no idea how to run the suggested queries from
within Project VBA - it appears that project VBA does not have the
ADODB object (as Excel does).

A reference or code snippet showing how to connect to the database
from within Project Professional 2007 using VBA would be very helpful

Thanks,
Aaron

 

[Gérard Ducouret]

Aaron,
Try the following... it worked on previous versions but I didn't tried it on
2007.
Tell me if it works for you.
Gérard

Dim cn As Object
Dim rst As Object
Dim rst_Task As Object
Dim Cmd As Object

Const DSN = "***" '"NomDSN"
Const STR_USER_IDENT = "*****" '"NomIdentificationDSN"
Const STR_PASSWORD_IDENT = "*******" 'PassWord

Sub Lecture()
Dim sQuery As String
Dim i As Integer
Dim oTache As Object
Dim iError As Integer

Dim strAuthor As String
Dim strManager As String

For Each oTache In ThisProject.Tasks
oTache.Delete 'Supprime toutes les lignes
existantes
Next

' Ouverture de connection à SQL Server par l'intermédiaire d'un DSN
système
Set cn = CreateObject("ADODB.Connection")
cn.Mode = adModeRead 'adModeReadWrite (Lecture seule!)
cn.ConnectionString = "DSN=" & DSN & ";UID=" & STR_USER_IDENT & " ;PWD="
& STR_PASSWORD_IDENT & ";"
cn.Open

' Récupération des enregistrements de la table des projets de la base de
données pointée par le DSN
' 1ere interrogation :
sQuery = "SELECT * FROM MSP_PROJECTS"
Set rst = CreateObject("ADODB.Recordset")
Set rst = cn.Execute(sQuery, , adCmdText)

With rst
While Not .EOF
i = i + 1

ThisProject.Tasks.Add Name:=" "
ThisProject.Tasks(i).SetField FieldID:=pjTaskName, Value:=![PROJ_NAME]
ThisProject.Tasks(i).SetField FieldID:=pjTaskText12,
Value:=Format(![PROJ_INFO_STATUS_DATE], "dd/mm/yy")

If IsDate(![PROJ_INFO_STATUS_DATE]) Then
ThisProject.Tasks(i).SetField FieldID:=pjTaskNumber12,
Value:=Format((Date - ![PROJ_INFO_STATUS_DATE]) + 1, "###")
End If

On Error GoTo er:
strAuthor = Space(250)
strManager = Space(250)

iError = 1
strAuthor = ![PROJ_PROP_AUTHOR]
iError = 2
strManager = ![PROJ_PROP_MANAGER]

ThisProject.Tasks(i).SetField FieldID:=pjTaskText14, Value:=strAuthor
'Reste vide
ThisProject.Tasks(i).SetField FieldID:=pjTaskText10, Value:=strManager
'Reste vide
..../....