OLE Automation Project example

Here's an example which builds a set of schedules and then publishes them for the Internet (complete with HyperLinks) with the SaveHTMLDrillDown method. (Cool!) Try this example

The Code:

Sub Main()

Dim objproject, tasks, T As Object

Dim objmilestonesmain As Variant

Dim objmilestonessub(7) As Variant

'Start up Milestones

Set objmilestonesmain = CreateObject("Milestones")
objmilestonesmain.Activate

'create a folder for the schedules

On Error GoTo folderexists

Set fs = CreateObject("Scripting.FileSystemObject")

fs.createfolder "c:\tempmilesx"

folderexists:

'create 5 separate project schedules

For x = 1 To 5

Set objmilestonessub(x) = CreateObject("Milestones")

With objmilestonessub(x)

.Activate

'symbol 1 will be a lime inverted triangle

.settoolboxsymbolproperty 1, "Type", 1

.settoolboxsymbolproperty 1, "FillColor", 5

'symbol 2 will be a red triangle

.settoolboxsymbolproperty 2, "Type", 2

.settoolboxsymbolproperty 2, "FillColor", 6

'symbols 3 and 4 will be black stars

.settoolboxsymbolproperty 3, "Type", 5

.settoolboxsymbolproperty 3, "FillColor", 18

.settoolboxsymbolproperty 4, "Type", 5

.settoolboxsymbolproperty 4, "FillColor", 18

'symbols 5 and 6 will be blue squares

.settoolboxsymbolproperty 5, "Type", 6

.settoolboxsymbolproperty 5, "FillColor", 3

.settoolboxsymbolproperty 6, "Type", 6

.settoolboxsymbolproperty 4, "FillColor", 3

'symbol 7 will be a yellow 5-sided triangle

.settoolboxsymbolproperty 7, "Type", 40

.settoolboxsymbolproperty 7, "FillColor", 4

'symbol 8 will be a down pointing 5-sided triangle

.settoolboxsymbolproperty 8, "Type", 41

.settoolboxsymbolproperty 8, "FillColor", 4

'symbols 9 and 10 will be green octagons

.settoolboxsymbolproperty 9, "Type", 56

.settoolboxsymbolproperty 9, "FillColor", 13

.settoolboxsymbolproperty 10, "Type", 56

.settoolboxsymbolproperty 10, "FillColor", 13

'set up one connector in the toolbox

.settoolboxhorizontalconnectorproperty 1, "Type", 7

'set up a couple of columns

.setcolumnproperty 1, "TextAlign", 1

.setcolumnproperty 2, "TextAlign", 1

.setcolumnwidth 1, 2.4

.setcolumnwidth 2, 1.5

.setcolumnproperty 2, "SmartColumn", "duration"

.setcolumnproperty 1, "ColumnHeadingLine1", "Project " + Str(x)

.setcolumnproperty 1, "ColumnHeadingLine2", "Tasks"

.setcolumnproperty 2, "ColumnHeadingLine1", "Duration"

.setfontstyle 12, 1, 18

.setfontstyle 6, 1, 18

.setfontstyle 13, 1, 18

.setfontstyle 3, 1, 24

.setfontstyle 4, 1, 24

'hide the date for all symbols

For X2 = 1 To 10

.settoolboxsymbolproperty X2, "DatePosition", 13

Next X2

.SetStartAndEndDates "06/01/2001", "11/15/2001"

For tasks = 1 To 5

taskname = "Project " + Str(x) + " Task: " + Str(tasks)

.putcell tasks, 3, taskname

symboltype1 = tasks * 2 - 1

symboltype2 = tasks * 2

connectortype = 1

thedate = Trim(Str(tasks + 5)) + "/15/2001"

.addtaskusingduration tasks, thedate, symboltype1, connectortype, 0, symboltype2, 12 + tasks, "Day"

.setsymbolproperty tasks, 1, "SymbolDatePosition", 2

.setsymbolproperty tasks, 2, "SymbolDatePosition", 3

.setsymbolproperty tasks, 1, "DateBack", "transparent"

.setsymbolproperty tasks, 2, "DateBack", "transparent"

.setsymbolproperty tasks, 1, "TextBack", "transparent"

                .setsymbolproperty tasks, 2, "TextBack", "transparent"
                .refreshtask tasks
            Next tasks

.SetTitle1 "Project " + Str(x)

.SetTitle2 "DrillDown Example"

.SetTitle3 "Note: dummy dates used for this example!"

.setlinesperpage 5
FileNamezzz = "c:\tempmilesx\project" + Trim(Str(x)) + ".mla"

.save FileNamezzz

.Close

End With

Next x 'next schedule

'make the top level schedule

Set objmilestonessub(6) = CreateObject("Milestones")

With objmilestonessub(6)

'Start Milestones

.Activate

.SetStartAndEndDates "06/01/2001", "11/15/2001"

.putcell 1, 3, "Project 1"

.putcell 2, 3, "Project 2"

.putcell 3, 3, "Project 3"

.putcell 4, 3, "Project 4"

.putcell 5, 3, "Project 5"

.setlinesperpage 5

.addtaskusingduration 1, "6/15/2001", 1, 1, 0, 2, 20, "Day"

.addtaskusingduration 2, "7/15/2001", 1, 1, 0, 2, 20, "Day"

.addtaskusingduration 3, "8/15/2001", 1, 1, 0, 2, 20, "Day"

.addtaskusingduration 4, "9/15/2001", 1, 1, 0, 2, 20, "Day"

.addtaskusingduration 5, "10/15/2001", 1, 1, 0, 2, 20, "Day"

For x = 1 To 5

.setsymbolproperty x, 1, "SymbolText", "Click", 1

.setsymbolproperty x, 1, "SymbolText", "Here", 2

.setsymbolproperty x, 1, "DateBack", "transparent"

.setsymbolproperty x, 2, "DateBack", "transparent"

.setsymbolproperty x, 1, "TextBack", "transparent"

.setsymbolproperty x, 2, "TextBack", "transparent"

Next x

.setcolumnproperty 1, "TextAlign", 1

.setcolumnwidth 1, 2.4

.SetTitle1 "Main Project Schedule"

.SetTitle2 "Click a start symbol to drill down"

.setfontstyle 3, 1, 24

.setfontstyle 4, 1, 24

.setsymbolproperty 1, 1, "Symbolhyperlink", "C:\tempmilesx\project1.mla"

.setsymbolproperty 2, 1, "Symbolhyperlink", "C:\tempmilesx\project2.mla"

.setsymbolproperty 3, 1, "Symbolhyperlink", "C:\tempmilesx\project3.mla"

.setsymbolproperty 4, 1, "Symbolhyperlink", "C:\tempmilesx\project4.mla"

.setsymbolproperty 5, 1, "Symbolhyperlink", "C:\tempmilesx\project5.mla"

.save "c:\tempmilesx\toplevel3.mla"

.keepscheduleopen

End With

'create the HTML files with hotspots (one step! check it out!)

    With objmilestonessub(6)
        .setinternetpublishingoptions 2, "Test", 1, 1, 1, 1, "", 99, 3, 1, 1, 1, 1, 1, 0, 1
        .SaveHTMLHyperlinkDrillDown "c:\tempmilesx\toplevel3.htm"

End With

Exit Sub

End Sub

To try this example:

Click here to download a Zip file (MilestonesVBExample3.Zip) containing the above VB code.

Click here for a VB.Net version

KIDASA Software, Inc. Website