Exporting data from MS Project

[marky]

Hi
I'm trying exporting data from Ms Project table to a string using vba ,and get some problems
When the record's number in project file is not so much, e.g. 10 , my program always works perfectly. But when the records reach some limitation,which seems to depends on the content of the project table,it doesn't work any longer.
For example, from one project table, my vba program can export at most 1323 records successfully ,while from another, it can only export 711 records

the following is the code. Any assistance would be greatly appreciated. and any direct message to my email is also warmly welcome

Public Function getFromProjectData(prjFilename As String, strFieldNames As String) As Strin
Dim blnExist As Boolean
Dim fieldNames() As Strin


strPrompt = "判断入å£å‚数：文件是å¦å­˜åœ¨
If fileExist(prjFilename) = False Then GoTo ExitDoo
strPrompt = "判断入å£å‚数：是å¦éœ€è¦å­—段
fieldNames = Split(strFieldNames, ":"
If UBound(fieldNames) < LBound(fieldNames) Then GoTo ExitDoo

On Error Resume Nex
Dim pj As Objec
Dim taskTemp As Tas
strPrompt = "得到Project对象
Set pj = GetObject(, "MSProject.Project"
If Err.Number <> 0 The
blnExist = Fals
Err.Clea
On Error GoTo ErrorHandl
strPrompt = "创建Project对象
Set pj = CreateObject("MSProject.Project"
Els
blnExist = Tru
End I

strPrompt = "打开Project文件
pj.Application.FileOpen Name:=prjFilename, ReadOnly:=True, FormatID:="MSProject.MPP
getFromProjectData = "<?xml version='1.0' encoding='gb2312'?>" & "<Project>
Dim lngTaskCount As Lon
lngTaskCount = pj.Application.ActiveProject.Tasks.coun

Dim i As Long, j As Long, k As Long, lngCount As Lon
Dim blnLook As Boolea
Dim strField As String, strValue As Strin
Dim listFieldName As MSProject.List, listFieldID As MSProject.Lis
Dim indexList() As Lon
pj.Application.SelectRow 1, Fals
Set listFieldName = pj.Application.ActiveSelection.FieldNameLis
Set listFieldID = pj.Application.ActiveSelection.FieldIDLis
lngCount = listFieldName.coun

indexList = getIndexList(listFieldName, fieldNames
If IsNull(indexList) Then GoTo ExitDoo

strPrompt = "write table
getFromProjectData = getFromProjectData & "<Table>
getFromProjectData = getFromProjectData & "<Name>" & ActiveProject.CurrentTable & "</Name>
For j = 1 To lngCoun
blnLook = Fals
For k = LBound(indexList) To UBound(indexList
If indexList(k) = j Then blnLook = Tru
Next
If blnLook The
getFromProjectData = getFromProjectData & "<Field>
getFromProjectData = getFromProjectData & "<Name>" & fieldNameArray(findIndexByID(listFieldID(j))) & "</Name>
getFromProjectData = getFromProjectData & "<NewName>" & listFieldName(j) & "</NewName>
getFromProjectData = getFromProjectData & "<FieldID>" & listFieldID(j) & "</FieldID>
getFromProjectData = getFromProjectData & "</Field>
End I
Next
getFromProjectData = getFromProjectData & "</Table>



strPrompt = "write data
For i = 1 To lngTaskCoun
Set taskTemp = pj.Application.ActiveProject.Tasks(i
getFromProjectData = getFromProjectData & "<Task>
For j = 1 To lngCoun
blnLook = Fals
For k = LBound(indexList) To UBound(indexList
If indexList(k) = j Then blnLook = Tru
Next
If blnLook The
strField = fieldNameArray(findIndexByID(listFieldID(j))
strValue = taskTemp.GetField(listFieldID(j)
If listFieldID(j) = 188743885 Then strValue =
getFromProjectData = getFromProjectData & "<Field>
getFromProjectData = getFromProjectData & "<Name>" & strField & "</Name>
getFromProjectData = getFromProjectData & "<Value>" & strValue & "</Value>
getFromProjectData = getFromProjectData & "</Field>
End If
Next j
getFromProjectData = getFromProjectData & "</Task>"
Next i

MsgBox (getFromProjectData)

'关闭文件并退出Project
If blnExist Then
pj.Application.FileClose (pjDoNotSave)
Else
pj.Application.FileExit (pjDoNotSave)
End If

getFromProjectData = getFromProjectData & "</Project>"
GoTo ExitDoor
Exit Function

ErrorHandle:
MsgBox getFromProjectData
getFromProjectData = ""
ExitDoor:
'释放对象
Set taskTemp = Nothing
Set pj = Nothing
End Function






regards
marky