首先在VBA中引用StarTeam SDK，程序如下
' Sample code showing how to connect to a
' StarTeam Server using Microsoft Visual Basic.
Sub StarTeam()
Dim strAddress As String
Dim nPort As Long
Dim strUser As String
Dim strPassword As String
strAddress = "StarTeamserver"
nPort = 49201
strUser = "user"
strPassword = "password"
' Create a new StarTeam Server Factory.
Dim Factory As New StServerFactory
' Use factory to create a new initialized Server object.
Dim Server As StServer
Set Server = Factory.Create(strAddress, nPort)
' Establish a connection to the Server.
' This is optional - logOn() connects if necessary.
Server.Connect
' LogOn as a specific user.
Server.logOn strUser, strPassword
' Use the Server object to enumerate
' Projects and Views, etc.
Dim project As StProject
Set project = FindProject(Server, "Project")
Dim view As StView
'For Each V In project.Views
Set view = project.DefaultView
Dim folder As StFolder
Set folder = view.RootFolder
Call WordToStarTeam(Server, folder)
' Disconnect when finished.
Server.Disconnect
End Sub
' Enumerates the projects available on the given
' server, looking for the one with the given name.
Public Function FindProject(Server As StServer, strName As String) As StProject
'Set FindProject = Null
For Each P In Server.Projects
If P.Name = strName Then
Set FindProject = P
Exit For
End If
Next
End Function
Sub WordToStarTeam(Server As StServer, folder As StFolder)
Dim table As table
Dim celTable As Cell
Dim rngTable As Range
Dim startDate, finishDate As Date
Dim task As StTask
Dim taskFactory As New StTaskFactory
Dim user As StUser
Dim userID As Long
Dim taskName As String
Set table = ActiveDocument.Tables(1)
Set celTable = table.Cell(2, 2)
Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
End:=celTable.Range.End - 1)
startDate = rngTable.Text
Set celTable = table.Cell(2, 4)
Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
End:=celTable.Range.End - 1)
finishDate = rngTable.Text
For i = 4 To table.Rows.Count
Set celTable = table.Cell(i, 2)
Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
End:=celTable.Range.End - 1)
taskName = rngTable.Text
If rngTable.Italic = 0 Then '斜体表示没有任务(返回-1)
Set celTable = table.Cell(i, 4)
Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
End:=celTable.Range.End - 1)
Set task = taskFactory.Create(folder)
task.Name = taskName
Dim bFound As Boolean
bFound = False
For Each user In Server.ActiveUsers
If user.Name = Trim(rngTable.Text) Then
userID = user.ID
bFound = True
End If
Next
If Not bFound Then
Debug.Print Trim(rngTable.Text) + " not found!"
Exit For
End If
task.Responsibility = userID
task.Status = 1 '0: Pending, 1:Ready to Start, 2:In Progress, 3:Finished, 4, Closed
task.EstimatedStart = startDate
task.EstimatedFinish = finishDate
task.Duration = 40
task.Update
End If
Next
End Sub