Dim objmilestones As Object
Dim numberofrows As Integer
Dim filename As String
Sub CreateSpreadsheet()
Dim numberofrows As Integer
Dim taskrow As Integer
Dim taskname As String
Dim date1 As String, date2 As Date
'get the last file name used from the registry
filenamex = GetSetting("milestones", "testprogramfilename", "milesfilename")
If filenamex = "" Then filenamex = "c:\test.mla"
filename = InputBox("Enter the name of the Milestones File you want to
use", "Test VB Program", filenamex)
If filename = "" Then GoTo quitprogram
'save the new file name to the registry
SaveSetting "milestones", "testprogramfilename", "milesfilename", filename
'open the file, creating the Milestones object
Set objmilestones = GetObject(filename)
'activate milestones
With objmilestones
.Activate
'find out how many task rows there are on the schedule
numberofrows = .GetNumberoflines
If numberofrows < 1 Then
MsgBox "Milestones file doesn't have any information"
GoTo quitprogram
End If
'loop for each row on the schedule
For taskrow = 1 To numberofrows
' how many symbols are there?
numberofsymbolsontaskline = .GetNumberofSymbolsInLine(taskrow)
If numberofsymbolsontaskline < 1 Then GoTo nosymbols
date1 = .getsymbolproperty (taskrow, 1, "Date")
Worksheets("Sheet1").Cells(taskrow + 1, 2).Value = date1
If numberofsymbolsontaskline > 1 Then
date2 = .getsymbolproperty(taskrow, 2, "Date")
Worksheets("Sheet1").Cells(taskrow + 1, 3).Value = date2
Else ' put the startdate in the end date field if there is only one symbol
Worksheets("Sheet1").Cells(taskrow + 1, 3).Value = date1
End If
nosymbols:
taskname = .getcelltext(taskrow, 1)
If taskname <> "" Then Worksheets("Sheet1").Cells(taskrow + 1, 1).Value =
taskname
Next taskrow
quitprogram:
.keepscheduleopen
End With
End
End Sub
|