Example 9 - Microsoft Access graphic file generation

Public Sub CreateSchedule()

' this function updates the schedule using data from a table

Dim dbsCurrent As Database
Dim rstTable1 As Recordset
Dim percentcomplete As Double
Dim numberoftasklines As Integer
Dim numberofsymbols As Integer
Dim x As Integer
Dim x2 As Integer
Dim TaskNumber As Integer
Dim tempstring As String

'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

'Start with a template
        .Template "AccessExample.mtp"
        .Refresh
        .setmiscproperty "Use4DigitYears", "1"
      
TaskNumber = 0

   'Start of loop
   Do Until rstTable1.EOF
    TaskNumber = TaskNumber + 1

        On Error GoTo SkipDate
        tempstring = rstTable1!percentcomplete
        
        .SetOutlineLevel TaskNumber, rstTable1!OutlineLevel
        'Use Milestones Etc. OLE Automation calls to add symbols to the schedule
        If rstTable1!OutlineLevel = 1 Then
        .AddSymbol TaskNumber, Format(rstTable1!StartDate, "mm/dd/yy"), 1, 1, 2
        .AddSymbol TaskNumber, Format(rstTable1!EndDate, "mm/dd/yy"), 2, 1, 2
        End If
        If rstTable1!OutlineLevel > 1 Then
        .AddSymbol TaskNumber, Format(rstTable1!StartDate, "mm/dd/yy"), 1, 1, 2
        .AddSymbol TaskNumber, Format(rstTable1!EndDate, "mm/dd/yy"), 2, 1, 2
        End If
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)
        If Len(tempstring) > 0 Then
          .setpercentcomplete TaskNumber, CDbl(tempstring)
        End If
        
   
        .RefreshTask TaskNumber
        'Move to the next record
        rstTable1.MoveNext
   Loop
   
   ' End of loop.
        .SetLinesPerPage TaskNumber
        .SetTitle1 "ACCESS OLE AUTOMATION EXAMPLE"
        .SetTitle2 "Milestones Professional"
        .SetStartAndEndDates "1/1/2023", "12/31/2024"
         
        .Refresh
        
   'Close Access Table
   rstTable1.Close

   'Keep Milestones, Etc. schedule open
    .KeepScheduleOpen
End With
    

Exit Sub
   
End Sub