Milestones Professional Automation: Microsoft Access VBA Examples

Warning: The information on these pages should only be used by software developers who are familiar with a Windows programming environment. KIDASA does not take responsibility for any damage caused to your information or computer due to programming errors.

Access VBA Example #1

Here’s an example of how you might use Milestones Professional’s OLE Automation to take information from an Access Table and generate a formatted project schedule. 
The “ScheduleData” Access table:
  

OutlineLevel

Task

Manager

Funding1999

Funding2000

StartDate

EndDate
1 Task 1 Jane $333.00 $123.00 2/10/99 9/14/00
2 Task 1-1 John $234.00 $234.00 4/1/99 10/31/99
2 Task 1-2 Patrick $345.00 $345.00 5/1/99 10/31/99
2 Task 1-3 Glen $456.00 $456.00 7/15/99 2/3/00
1 Task 2 Mary $567.00 $567.00 10/1/99 10/31/00
2 Task 2-1 Donald $999.00 $343.00 3/1/99 6/30/99
2 Task 2-2 Sue $342.00 $999.00 4/1/99 6/6/00
2 Task 2-3 Cari $543.00 $434.00 5/15/99 12/15/00
2 Task 2-4 Jackie $3,000.00 $2,000.00 5/15/99 12/1/00
2 Task 2-5 Carl $342.00 $342.00 3/1/99 4/1/99
1 Task 3 Kirk $333.00 $333.00 4/1/99 4/13/00
2 Task 3-1 Dave $444.00 $444.00 6/1/00 6/30/00
2 Task 3-2 Jane $555.00 $555.00 5/1/99 5/1/00
2 Task 3-3 Earl $332.00 $232.00 4/4/99 6/19/00
2 Task 3-4 Jane $332.00 $232.00 4/4/99 4/20/00
2 Task 3-5 Dave $332.00 $232.00 4/4/99 6/6/00
2 Task 3-6 Kirk $332.00 $232.00 4/4/99 1/18/00
2 Task 3-7 Carl $332.00 $232.00 4/4/99 6/6/00
2 Task 3-8 Jackie $332.00 $232.00 4/4/99 5/10/00
1 Task 4 Cari $332.00 $232.00 4/4/99 6/12/00
2 Task 4-1 Sue $332.00 $232.00 4/4/99 7/29/00
2 Task 4-2 Donald $332.00 $232.00 4/4/99 11/26/00
2 Task 4-3 Mary $332.00 $232.00 4/4/99 12/29/00
2 Task 4-4 Jim $332.00 $232.00 4/4/99 8/4/99
The Milestones Professional Schedule:
accessexample
The Access Visual Basic Program:
  
Here’s a Visual Basic Program that generates an outlined Milestones Professional schedule using the data in the Access table.  The Milestones OLE calls are displayed in red.
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
To try this example:
Click here to download a self-extracting EXE file containing:
 – The Access Database (AccessExample.mdb)
 – The Milestones Professional Template (AccessTemplate.mtp)
 
 
(This download is recommended for experienced Access users with some programming knowledge.)

Access VBA Example #2

This example shows how you might display a Milestones Professional schedule based on data in a Microsoft Access database.  The same technique can be applied to other database systems.
  In this case, the MS Access database includes 3 tables (table1, table2, and table3).  When the Main() sub is executed (in the Milestones module), a form is presented.  It is initially populated with a schedule using dates from table1.  From then on, the user can press one of 3 buttons labeled “Table1”, “Table2”, or “Table3” and cause Milestones to change the picture which is displayed.

This is accomplished by keeping a Milestones Professional schedule object open while the MS Access application is open and closing it when the MS Access application closes.  While open, when the user presses one of the button, the software will:

1 Erase any previous schedule information from the Milestones schedule and get ready for the next set of data.  This is done using the DeleteCurrentPage method.
2 Open the MS Access table which corresponds to the button pressed by the user and go through it record by record to retrieve the task and manager names, Funding information and start and end dates.
3 Generate a bitmap for the first page of the schedule.  After a second (timeout function called to pause), the image is shown in the user’s form.
   (We are not experts at MS Access programming.  This example is offered to illustrate the use of Milestones Professional interface calls and give you ideas for your programming projects. This code is not complete and is not meant to be used as part of any of your projects.)
The Form:
 oleaut1
The Access Visual Basic Program:
Public dbsCurrent As Database
Public rstTable1 As Recordset
Public numberoftasklines As Integer, numpages As Integer
Public x As Integer
Public x2 As Integer
Public TaskNumber As Integer
Public objmilestones As Object
Public StartDate As String, finishdate As String, schedulestartdate As String, schedulefinishdate As String
Public xDatediff As Long
Public title As String
Public selectedtable As String

Sub main()
DoCmd.OpenForm “form1”
‘Identify the table
Set dbsCurrent = CurrentDb()

Set rstTable1 = dbsCurrent.OpenRecordset(“table1”, dbOpenTable)
Set objmilestones = CreateObject(“Milestones”)

formatmilestonesschedule
Milestones1.selectedtable = “table1”
Set Milestones1.rstTable1 = dbsCurrent.OpenRecordset(“table1”, dbOpenTable)
Milestones1.title = “T A B L E 1”
Milestones1.CreateSchedule

Form_Form1.showstuff

End Sub

Public Sub CreateSchedule()

schedulestartdate = “12/31/2399”
schedulefinishdate = “1/1/1100”

‘ this function updates the schedule using data from a table

With objmilestones
‘ Locate first record in selected Access table
rstTable1.MoveFirst

‘check Milestones object and see if it has been used.
‘are there any tasks? If so, delete and make object
‘ready for new user’s new table selection
numpages = .getnumberofpages
If x > 1 Then
For x = numpages To 1
.setcurrentpage x
.deletecurrentpage
Next x
Else
numberoftasklines = .getnumberoflines
If numberoftasklines > 1 Then .deletecurrentpage
End If

‘color the rows differently depending upon which table is selected
For x = 0 To 2
Select Case Milestones1.selectedtable
Case “table1”
.SetScheduleGridlinesAndShades x, -1, 0, 15, 0, 4, 0
Case “table2”
.SetScheduleGridlinesAndShades x, -1, 0, 16, 0, 4, 0
Case “table3”
.SetScheduleGridlinesAndShades x, -1, 0, 17, 0, 4, 0
End Select
Next x
‘Display the tasks
TaskNumber = 0
Do Until rstTable1.EOF

On Error GoTo done
‘Use Milestones Etc. OLE Automation calls to add symbols to the schedule
StartDate = Format(rstTable1!StartDate, “mm/dd/yy”)
‘Start of loop
xDatediff = DateDiff(“d”, StartDate, schedulestartdate)
If xDatediff > 0 Then schedulestartdate = StartDate

finishdate = Format(rstTable1!EndDate, “mm/dd/yy”)
xDatediff = DateDiff(“d”, finishdate, schedulefinishdate)
If xDatediff < 0 Then schedulefinishdate = finishdate TaskNumber = TaskNumber + 1

.AddSymbol TaskNumber, StartDate, 1, 1, 2
.AddSymbol TaskNumber, finishdate, 2, 1, 2
.SetOutlineLevel TaskNumber, rstTable1!OutlineLevel
‘Add information to the task columns
.PutCell TaskNumber, 1, rstTable1!Manager
.PutCell TaskNumber, 2, rstTable1!Task
.PutCell TaskNumber, 11, “$” + Str(rstTable1!Fundingyear1)
.PutCell TaskNumber, 12, “$” + Str(rstTable1!Fundingyear2)
.refreshtask TaskNumber
‘Move to the next record
rstTable1.MoveNext
Loop

done:

‘ Put up a title and set the schedule’s start and end dates
If TaskNumber > 1 Then .setlinesperpage TaskNumber
.SetTitle1 title
.SetTitle2 “Access Example”
.setlinesperpage TaskNumber
.SetStartAndEndDates schedulestartdate, schedulefinishdate
.Refresh

‘ Create a bitmap with the new schedule
.savebitmap “c:milestones.bmp”

‘ pause to give bitmap time to save before going on
timeout
End With

Exit Sub

End Sub

Sub closeout()
‘rstTable1.Close

‘Keep Milestones, schedule open
‘objmilestones.Close “nosave”

End Sub

Sub timeout()

Dim PauseTime, Start, Finish, TotalTime
PauseTime = 2 ‘ 1 second
Start = timer ‘ Set start time.
Do While timer < Start + PauseTime x = 1 ' Yield to other processes. Loop Finish = timer ' Set end time. TotalTime = Finish - Start ' Calculate total time. End Sub Public Sub formatmilestonesschedule() ' FormatMilestones Schedule ' objmilestones.Activate objmilestones.use20columns objmilestones.setlegendheight 0# For x = 1 To 20 objmilestones.setcolumnproperty x, "Smartcolumn", "none" objmilestones.setcolumnproperty x, "Width", 0# objmilestones.setcolumnproperty x, "ColumnHeadingLine1", "" objmilestones.setcolumnproperty x, "ColumnHeadingLine2", "" objmilestones.setcolumnproperty x, "HeadingBackgroundColor", 11 objmilestones.setcolumnproperty x, "TextAlign", 1 Next x objmilestones.settoolboxsymbolproperty 1, "DatePosition", 13 objmilestones.settoolboxsymbolproperty 2, "DatePosition", 13 objmilestones.setcolumnproperty 1, "Width", 1# objmilestones.setcolumnproperty 1, "ColumnHeadingLine1", "Manager"

objmilestones.setcolumnproperty 2, “Width”, 1.6
objmilestones.setcolumnproperty 2, “ColumnHeadingLine1”, “Task”
objmilestones.setcolumnproperty 2, “Indent”, 0.2
objmilestones.setcolumnproperty 2, “TextAlign”, 0

objmilestones.setcolumnproperty 11, “Width”, 1
objmilestones.setcolumnproperty 11, “ColumnHeadingLine1”, “Year 1”
objmilestones.setcolumnproperty 11, “ColumnHeadingLine2”, “Funding”

objmilestones.setcolumnproperty 12, “Width”, 1
objmilestones.setcolumnproperty 12, “ColumnHeadingLine1”, “Year 2”
objmilestones.setcolumnproperty 12, “ColumnHeadingLine2”, “Funding”
objmilestones.SetSummaryBarDisplay 0
End Sub
In the Form1 Module:

Option Compare Database
Private Sub Form1_Activate()
Me.Repaint
End Sub

Private Sub Command4_Click()
Milestones1.selectedtable = “table2”
rstTable1.Close

Set Milestones1.rstTable1 = dbsCurrent.OpenRecordset(“table2”, dbOpenTable)
Milestones1.title = “T A B L E 2”

Milestones1.CreateSchedule
Image3.Picture = “c:milestones.bmp”
Image3.Visible = False
Image3.Visible = True
End Sub

Private Sub Command5_Click()
rstTable1.Close

Milestones1.selectedtable = “table1”
Set Milestones1.rstTable1 = dbsCurrent.OpenRecordset(“table1”, dbOpenTable)
Milestones1.title = “T A B L E 1”
Milestones1.CreateSchedule

Image3.Picture = “c:milestones.bmp”
Image3.Visible = False
Image3.Visible = True

End Sub

Private Sub Command6_Click()
Milestones1.selectedtable = “table3”
rstTable1.Close

Set Milestones1.rstTable1 = dbsCurrent.OpenRecordset(“table3”, dbOpenTable)
Milestones1.title = “T A B L E 3”
Milestones1.CreateSchedule

Image3.Picture = “c:milestones.bmp”
Image3.Visible = False
Image3.Visible = True
End Sub

Public Sub showstuff()
Image3.Picture = “c:milestones.bmp”
Image3.Visible = False
Image3.Visible = True
End Sub

Private Sub Command7_Click()
Milestones1.closeout
End Sub
To try this example:
Click here to download a self-extracting EXE file containing the above code.
(This download is recommended for experienced Access users who are also experience programmers.)

Click here to visit our main programmer’s page.