Exporting data from MS Project
From: marky (zju_hesong_at_hotmail.com)
Date: 04/26/04
- Next message: Peter Hewett: "Re: VBA Syntax question"
- Previous message: Ed Landau: "VBA Syntax question"
- Messages sorted by: [ date ] [ thread ]
Date: Sun, 25 Apr 2004 23:06:03 -0700
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 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'?>" & "<Project>"
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>" & ActiveProject.CurrentTable & "</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>" & fieldNameArray(findIndexByID(listFieldID(j))) & "</Name>"
getFromProjectData = getFromProjectData & "<NewName>" & listFieldName(j) & "</NewName>"
getFromProjectData = getFromProjectData & "<FieldID>" & listFieldID(j) & "</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>" & 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
- Next message: Peter Hewett: "Re: VBA Syntax question"
- Previous message: Ed Landau: "VBA Syntax question"
- Messages sorted by: [ date ] [ thread ]
Relevant Pages
|
|
