Prj 2 Access
Well, scanning didn't work so well, so I retyped. Faster, anyway.
Amazing how simple it is once it happens. It just takes forever to figure out how to do it. I repeat my disappointment with Microsoft documentation.......
Hope this helps. I didn't clean up the code, so there are a few extraneous lines.
===================================
Function ReadProjectFiles()
On error goto Err_ReadProjectFiles
Dim varFileName as Variant 'Not needed
Dim prjApp as MSProject.Application
Dim prjProject as MSProject.Project
Dim dbs as ADODB.Connection 'Not needed
Dim sked_rst as New ADODB.Recordset 'You can prebuild this table or create with code.
Dim filenames_rst as New ADODB.Recordset
Dim tsk As Object
Dim strFileName as String
Dim strPath as Path
Dim strSkedFilesTable as String
Dim strSkedTable as String
Dim intCt as Integer
Dim iProceed as Boolean
strSkedFilesTable = "tblFileNames" 'This table was loaded with .mpp files
strPath = "c:\path2files" 'Path to the files
Set prjApp = CreateObject("MSProject.Application")
prjApp.Visible = False
prjApp.Alerts (True) 'God knows why the different syntax!
filenames_rst.Open strSkedFilesTable, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'In case this is a reload, clear the schedule table
sked_rst "delete * from " & strSkedTable, CurrentProject.Connection
'Then open the schedule table
sked_rst.Open strSkedFilesTable, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
filenames_rst.MoveFirst
'Might test to be sure there are records in the table before proceeding
iProceed = True
Do While iProjceed And Not filenames_rst EOF
strFileName = filenames_rst!mpp_name
prjApp.FileOpen (strPath & strFileName)
prjApp.Visible = False
prjApp.Alerts (True) 'God knows why the different syntax!
Set prjProject = prjApp.ActiveProject
'Process all tasks in each of the mpp files
For intCt = 1 to prjProject.Tasks.Count
Set tsk = prjProject.Tasks( intCt)
sked_rst.AddNew 'Add a new record to the Access table
If tsk Is Nothing Then
'Skip blank rows
Else
sked_rst!mpp_name = strFileName 'Have to know which mpp the task is in
sked_rst!unique_id = tsk.UniqueID
sked_rst!task_id = tsk.ID
sked_rst!Task = tsk.Name
sked_rst!outline_level = tsk.Outlinelevel
sked_rst!Start = tsk.Start
sked_rst!Finish = tsk.Finish
'And so on for as many fields as you need
End if
sked_rst.Update 'Be sure to save the record
Next
prj.fileClose pjDoNotSave
filenames_rst.MoveNext 'Get the next mpp file
Loop
Exit_ReadProjectFiles:
sked_rst.Close
filenames_rst.Close
Set sked_rst = Nothing
Set filenames_rst = Nothing
Exit Function
Err_ReadProjectFiles: