Add Access Data to Project

CT Witter

MrExcel MVP
Joined
Jul 7, 2002
Messages
1,212
I have the below code to add access data to ms project. The issue is that I want to preserve dependency and outline tasks. Has anyone done this before?
Is there a way to tell ms project that certain tasks belong together?

Thanks!
CT

Code:
Public Function basMSProject(OutputFolder As String)
' What:
' Author: LPJ Created: 9/1/99
' Last Revision: By: Ref:

On Error GoTo basMSProject_Err
'Me!ProgressBar.Visible = -1
'Me!lblOutput.Visible = -1
Dim ObjProj As MSProject.Application
Dim r As Recordset
Dim Ord As String
Dim i As Integer
Dim strMSProjPath As String
Dim myDb As Database
Dim msg, intRecs As Integer
Set myDb = CurrentDb

Set r = myDb.OpenRecordset("tbl1", dbOpenTable)

r.MoveLast
intRecs = r.RecordCount
'Me!ProgressBar.Value = 0
'Me!ProgressBar.Max = intRecs
r.MoveFirst
If r.EOF = -1 Then
r.Close
Exit Function
End If
DoCmd.Hourglass -1
Set ObjProj = CreateObject("MsProject.Application")
'If Dir(Me!OutputFolder, vbDirectory) = "" Then
'DoCmd.Beep
'MsgBox "Invalid output folder. Please check your spelling."
'GoTo basMSProject_Exit
'Else

strMSProjPath = OutputFolder
'End If

With ObjProj
.DisplayAlerts = False
.FileNew
Do Until r.EOF
'Me!ProgressBar.Value = Me!ProgressBar.Value + 1
.RowInsert
.SetTaskField "Name", r!Name
.SetTaskField "Start", Nz(r!Start, Date)
.SetTaskField "Duration", Nz(r!Duration, 1)
.SetTaskField "Resource Names", Nz("MXWorkPlan[100%]")
'.SetTaskField "ResourceNames", Nz(r!DeptID, "None")
'.SetTaskField "Notes", Nz(r!PMTitle, " ")
r.MoveNext
Loop
.FileSaveAs strMSProjPath & "MX_Work_Plan.mpp"
'Me!ProgressBar.Visible = 0
'Me!lblOutput.Visible = 0
If MsgBox("File output completed." & vbNewLine & "MS Project file: MX_Work_Plan.mpp" & vbNewLine & "can be found in " & strMSProjPath & "." & vbNewLine & vbNewLine & "Start MS Project to view output?", 36) = 6 Then
.Visible = True
.AppMaximize
Else
.Application.Quit
End If
End With
basMSProject_Exit:
On Error Resume Next
'Me!ProgressBar.Visible = 0
'Me!lblOutput.Visible = 0
Set ObjProj = Nothing
r.Close
DoCmd.Hourglass 0
Exit Function


basMSProject_Err:
DoCmd.Beep
If Err.Number = 429 Then
'App object doesn't exist
MsgBox "PREMO PAS cannot create the MS Project output. Verify MS Project is installed and working properly on this workstation.", 16, "basMSProject_Click"
Else
msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox msg, 16, "basMSProject_Click"
End If
Resume basMSProject_Exit
End Function
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

Forum statistics

Threads
1,221,810
Messages
6,162,108
Members
451,743
Latest member
matt3388

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top