Public Sub CreateSchedule()
' this function updates the schedule using data from a table
Dim dbsCurrent As Database
Dim rstTable1 As Recordset
Dim numberoftasklines As Integer
Dim numberofsymbols As Integer
Dim x As Integer
Dim x2 As Integer
Dim TaskNumber As Integer
'Identify the table
Set dbsCurrent = CurrentDb()
Set rstTable1 = dbsCurrent.OpenRecordset("scheduledata", dbOpenTable)
Set objMilestones = CreateObject("Milestones")
With objMilestones
' Locate first record.
rstTable1.MoveFirst
' Activate Milestones Professional Schedule
.Activate
.Template "AccessTemplate.mtp"
.Refresh
TaskNumber = 0
'Start of loop
Do Until rstTable1.EOF
TaskNumber = TaskNumber + 1
On Error GoTo SkipDate
'Use Milestones Professional OLE Automation calls to add symbols to the schedule
.AddSymbol TaskNumber, Format(rstTable1!StartDate,
"mm/dd/yy"), 1, 1, 2
.AddSymbol TaskNumber, Format(rstTable1!EndDate, "mm/dd/yy"), 2, 1, 2
.SetOutlineLevel TaskNumber,
rstTable1!OutlineLevel
SkipDate:
'Add information to the task columns
.PutCell TaskNumber, 1, rstTable1!Manager
.PutCell TaskNumber, 3, rstTable1!Task
.PutCell TaskNumber, 6, "$" + Str(rstTable1!Funding1999)
.PutCell TaskNumber, 7, "$" + Str(rstTable1!Funding2000)
.RefreshTask TaskNumber
'Move to the next record
rstTable1.MoveNext
Loop
' End of loop.
.SetLinesPerPage TaskNumber
.SetTitle1 "ACCESS OLE AUTOMATION EXAMPLE"
.SetTitle2 "Milestones Professional"
.SetStartDate "1/1/1999"
.SetEndDate "12/31/2000"
.Refresh
'Close Access Table
rstTable1.Close
'Keep Milestones Professional schedule open
.KeepScheduleOpen
End With
Exit Sub
End Sub
|