R there any limitation of row number when exporting from MS project using vba

[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 message directly to my email address 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

 

[JackD]

I am not certain why you are doing it this way.
I think that there is some limit on the length of a string.
Can you tell why you want it as a string?

-Jack

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 message directly to my email address is also warmly welcome.

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


strPrompt = "??????:??????"
If fileExist(prjFilename) = False Then GoTo ExitDoor
strPrompt = "??????:??????"
fieldNames = Split(strFieldNames, ":")
If UBound(fieldNames) < LBound(fieldNames) Then GoTo ExitDoor

On Error Resume Next
Dim pj As Object
Dim taskTemp As Task
strPrompt = "??Project??"
Set pj = GetObject(, "MSProject.Project")
If Err.Number <> 0 Then
blnExist = False
Err.Clear
On Error GoTo ErrorHandle
strPrompt = "??Project??"
Set pj = CreateObject("MSProject.Project")
Else
blnExist = True
End If

strPrompt = "??Project??"
pj.Application.FileOpen Name:=prjFilename, ReadOnly:=True, FormatID:="MSProject.MPP"
getFromProjectData = "<?xml version='1.0' encoding='gb2312'?>" &

Dim lngTaskCount As Long
lngTaskCount = pj.Application.ActiveProject.Tasks.count

Dim i As Long, j As Long, k As Long, lngCount As Long
Dim blnLook As Boolean
Dim strField As String, strValue As String
Dim listFieldName As MSProject.List, listFieldID As MSProject.List
Dim indexList() As Long
pj.Application.SelectRow 1, False
Set listFieldName = pj.Application.ActiveSelection.FieldNameList
Set listFieldID = pj.Application.ActiveSelection.FieldIDList
lngCount = listFieldName.count

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

strPrompt = "write table"
getFromProjectData = getFromProjectData & "<Table>"
getFromProjectData = getFromProjectData & "<Name>" &

For j = 1 To lngCount
blnLook = False
For k = LBound(indexList) To UBound(indexList)
If indexList(k) = j Then blnLook = True
Next k
If blnLook Then
getFromProjectData = getFromProjectData & "<Field>"
getFromProjectData = getFromProjectData & "<Name>" &

getFromProjectData = getFromProjectData & "<NewName>" &

getFromProjectData = getFromProjectData & "<FieldID>" &

getFromProjectData = getFromProjectData & "</Field>"
End If
Next j
getFromProjectData = getFromProjectData & "</Table>"



strPrompt = "write data"
For i = 1 To lngTaskCount
Set taskTemp = pj.Application.ActiveProject.Tasks(i)
getFromProjectData = getFromProjectData & "<Task>"
For j = 1 To lngCount
blnLook = False
For k = LBound(indexList) To UBound(indexList)
If indexList(k) = j Then blnLook = True
Next k
If blnLook Then
strField = fieldNameArray(findIndexByID(listFieldID(j)))
strValue = taskTemp.GetField(listFieldID(j))
If listFieldID(j) = 188743885 Then strValue = j
getFromProjectData = getFromProjectData & "<Field>"
getFromProjectData = getFromProjectData & "<Name>" &