Results 1 to 2 of 2
  1. #1
    Mrnorth is offline Novice
    Windows XP Access 2007
    Join Date
    Jun 2013
    Posts
    1

    Microsoft Project Object model


    I've had a nifty idea whereby I download an MS Project template from a blob in my SQL server DB. That bit works fine. I have a one-to-many Projects/tasks view that, as you can see creates the overall project and takes the child records and makes tasks out of them.

    The problem is the outlineindent. Each subtask becomes the parent of the next rather than clustering under each parent project. Does anyone kow what I'm missing? I don't fully understandf MS Project yet.

    Code:
        Dim rs As New ADODB.Recordset
        Dim prjApp As MSProject.Application
        Dim prjProject As MSProject.Project
        
        Dim intTask As Long
        Dim lngCPDID    Dim strTempFolder As String
        Dim rst As New ADODB.Recordset
        Dim strFolder As String
        Dim ADST As ADODB.Stream
        Dim bytData() As Byte
        Dim i As Long
        
    
        If Nz(txtStart, "") = "" Or Nz(txtEnd, "") = "" Then
            MsgBox "Enter some dates, dumbass!"
            Exit Sub
        End If
        strTempFolder = fGetSpecialFolderLocation(CSIDL_PERSONAL) & "\CPD2\"
        
        If FileOrDirExists(strTempFolder) = False Then
            MkDir strTempFolder
        End If
    
        rst.Open "select * from tbl_CPD_sourcefiles where filename='project1.mpp'", CurrentProject.Connection, adOpenStatic, adLockOptimistic
        Set ADST = New ADODB.Stream
        ADST.Type = adTypeBinary
        ADST.Open
        bytData() = rst.Fields("document").Value
        ADST.Write bytData
        ADST.SaveToFile strTempFolder & "project1.mpp", adSaveCreateOverWrite
        rst.Close
      
        Set prjApp = CreateObject("Msproject.Application")
        
        prjApp.FileOpen strTempFolder & "Project1.mpp", ReadOnly:=True
        prjApp.Visible = True
       
        Set prjProject = prjApp.ActiveProject
        
        If ynOpen = True Then
            strsql = "SELECT * FROM qry_CPD_workload where startdate > '" & Format(Me![txtStart], "yyyy-mm-dd") & "' and enddate<'" & Format(Me![txtEnd], "yyyy-mm-dd") & "' and status='open'"
        Else
            strsql = "SELECT * FROM qry_CPD_workload where startdate > '" & Format(Me![txtStart], "yyyy-mm-dd") & "' and enddate<'" & Format(Me![txtEnd], "yyyy-mm-dd") & "'"
        End If
        rs.Open strsql, CurrentProject.Connection, adOpenStatic, adLockOptimistic
        rs.MoveFirst
        For i = 0 To rs.RecordCount
            lngCPDID = rs.Fields("CPDID").Value
            n = rs.Fields("CPDID").Value & " - " & rs.Fields("description").Value
            prjProject.Tasks.Add Name:=n
            prjProject.Tasks.Item(rs.Fields("CPDID").Value & " - " & rs.Fields("description").Value).Start = CDate(DMin("startdate", "qry_CPD_workload", "cpdid=" & lngCPDID))
            prjProject.Tasks.Item(rs.Fields("CPDID").Value & " - " & rs.Fields("description").Value).Finish = CDate(DMax("enddate", "qry_CPD_workload", "cpdid=" & lngCPDID))
            prjProject.Tasks.Item(rs.Fields("CPDID").Value & " - " & rs.Fields("description").Value).ResourceNames = rs.Fields("teamleader").Value
            While rs.Fields("CPDID").Value = lngCPDID
                prjProject.Tasks.Add Name:=rs.Fields("CPDID").Value & " - " & rs.Fields("descriptions").Value
                prjProject.Tasks.Item(rs.Fields("CPDID").Value & " - " & rs.Fields("descriptions").Value).OutlineIndent
                prjProject.Tasks.Item(rs.Fields("CPDID").Value & " - " & rs.Fields("descriptions").Value).Start = CDate(rs.Fields("startdate").Value)
                prjProject.Tasks.Item(rs.Fields("CPDID").Value & " - " & rs.Fields("descriptions").Value).Finish = CDate(rs.Fields("enddate").Value)
                prjProject.Tasks.Item(rs.Fields("CPDID").Value & " - " & rs.Fields("descriptions").Value).ResourceNames = rs.Fields("teamleader").Value
                
                If rs.EOF = True Then
                    rs.Close
                    Set prjProject = Nothing
                    Set prjApp = Nothing
                Else
                    rs.MoveNext
                End If
            Wend
        Next i

  2. #2
    Join Date
    May 2013
    Location
    Dallas TX
    Posts
    1,742
    I think you wanted this forum - http://www.msofficeforums.com/project/.
    Last edited by Dal Jeanis; 06-05-2013 at 09:12 AM. Reason: oops

Please reply to this thread with any new information or opinions.

Similar Threads

  1. excel model that outgrew itself
    By canuck86 in forum Access
    Replies: 1
    Last Post: 04-10-2013, 11:54 AM
  2. Replies: 2
    Last Post: 12-30-2011, 08:07 PM
  3. Replies: 1
    Last Post: 09-03-2011, 07:01 PM
  4. Outlook Object Model question - automation
    By yeah in forum Programming
    Replies: 1
    Last Post: 11-23-2010, 02:05 PM
  5. Replies: 0
    Last Post: 10-13-2010, 03:28 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums