PDA

View Full Version : Solved: Access code to add resource eceptions to msproject



Steve64
06-12-2012, 04:27 AM
Im using the code below (Which is working fine) in access to open MS Project "GanttDept.mpp" file, the file has a resource list, Im trying to add non-working days to the resource calendars of the resources IE add holidays.
As you can see from the code I can add resource exceptions if I hard code it, how can I change this line : aProg.Resources("A Person").Calendar.Exceptions.Add Type:=1, Start:="12/06/2012", Finish:="15/06/2012", Name:="Leave"
So it will get; A Person, Start; Finish and Name from either a table; form or query, Iv tried [forms]![frmName]![text0]
I want the exceptions added this way when the project file opens as I won’t be monitoring the holidays, holidays are added to the access database already.

Public Function OpnMSProjectDept()
Dim appProj As Object
Dim aProg As Object
Set appProj = CreateObject("Msproject.Application")
appProj.fileopen "\\gbs2040\LocalDatabases$\TechnicalRequests\ExcelChart\GanttDept.mpp", readonly:=True
Set aProg = appProj.ActiveProject
appProj.Visible = True
aProg.Resources("A Person").Calendar.Exceptions.Add Type:=1, Start:="12/06/2012", Finish:="15/06/2012", Name:="Leave"
Set appProj = Nothing
Set aProg = Nothing
End Function


Thanks

Steve64
06-14-2012, 03:52 AM
After some head scratching, I got it to work :)


Public Function OpnMSProjectDept()
Dim appProj As Object
Dim aProg As Object
Dim db As dao.Database
Dim rs As dao.Recordset
Dim sqlStr As String
Dim stReName As String
Dim stReStart As String
Dim stReFin As String
Set appProj = CreateObject("Msproject.Application")
appProj.fileopen "file.mpp", readonly:=True
sqlStr = "SELECT * FROM qryLeavePJ '"
Set db = CurrentDb
Set rs = db.OpenRecordset(sqlStr)
rs.MoveFirst
Set aProg = appProj.ActiveProject
Do While Not rs.EOF
stReName = rs!Appt
stReStart = rs!ApptStart
stReFin = rs!ApptFinish
aProg.Resources(stReName).Calendar.Exceptions.Add Type:=1, Start:=stReStart, Finish:=stReFin, Name:="Leave"
rs.MoveNext
Loop
appProj.Visible = True

Set appProj = Nothing
Set aProg = Nothing
End Function