Quantcast
Channel: Project Customization and Programming forum
Viewing all articles
Browse latest Browse all 5347

Trouble Speeding up VBA Code in MSP

$
0
0

Hi Fellow Forum Members

I have been trying for some time to speed up a piece of code that I had help with producing on this forum.  However I have failed miserably.  This code is run from a master file and opens up to 8 other MSP files to extract data and bring it back to the master file.  It is taking around 30 to 40 minutes to run.  I would appreciate some help in trying to speed it up.  The code is shown below:

Sub EA_Release2_CPP_Update()

Dim pjApp As MSProject.Application
Dim FileToOpen
Dim Proj As MSProject.Project
Dim ts As Tasks
Dim t As Task
Dim fd As FileDialog
Dim uid As Integer
Dim ws As String
Dim sDate As Long
Dim Row As Integer
Dim wsCount As Integer
Set pjApp = MSProject.Application
Set ts = ActiveProject.Tasks
If pjApp Is Nothing Then
    MsgBox "Project is not installed"
    End
End If

pjApp.Visible = True
AppActivate "Microsoft Project"

Application.DisplayAlerts = False
Application.Calculation = xlManual

For Each t In ts
    Row = t.ID
    If Not t Is Nothing Then
        If Not t.Summary Then
            tws = t.GetField(FieldNameToFieldConstant("Text16"))
            tuid = t.GetField(FieldNameToFieldConstant("Text12"))
            If tws <> "" Then
                On Error GoTo ErrorHandler
                Application.FileOpenEx Name:="D:\Delivery Assurance\01 EA Dashboard\With GivesGets\" & tws & ".mpp", ReadOnly:=False, FormatID:="MSProject.MPP"
                'Projects("EA Release 2 CPP.mpp").Tasks(Row).Duration = ActiveProject.Tasks.UniqueID(tuid).Duration
                Projects("EA Release 2 CPP.mpp").Tasks(Row).Start = ActiveProject.Tasks.UniqueID(tuid).Start
                Projects("EA Release 2 CPP.mpp").Tasks(Row).Finish = ActiveProject.Tasks.UniqueID(tuid).Finish
                Projects("EA Release 2 CPP.mpp").Tasks(Row).PercentComplete = ActiveProject.Tasks.UniqueID(tuid).PercentComplete
                Projects("EA Release 2 CPP.mpp").Tasks(Row).BaselineFinish = ActiveProject.Tasks.UniqueID(tuid).BaselineFinish
                Projects("EA Release 2 CPP.mpp").Tasks(Row).Text4 = ActiveProject.Tasks.UniqueID(tuid).Text4
'                FileClose pjDoNotSave
            End If
        End If
    End If
Next t
GoTo Finish:
ErrorHandler:
MsgBox ("Either the plan " & tws & ".mpp" & " is not available or the UID (" & tuid & ") in the source plan has changed.  Please check and re-run this routine." _& "This routine will now exit and you will need to re-run it once you have corrected the missing details.")
Exit Sub
'pjApp.FileClose pjDoNotSave
Finish:
Application.Calculation = xlAutomatic
FilterApply Name:="All Tasks"

'pjApp.Quit
Set pjApp = Nothing
Application.DisplayAlerts = True
MsgBox ("EA Dashboard Updated.....")
End Sub

Many thanks in anticipation.

Tony


TKHussar


Viewing all articles
Browse latest Browse all 5347

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>