Search code examples
vbams-project

Detect when a change occurs on in an MS project file (when a date changes for example) and automatically log the change in an Excel file


I often have to make changes to a large MS project file. I would like to use the MS project event handler to detect when a change has been made to a task (a name change, date change, duration change, link change, etc), to copy the line on which the change occurred, and to paste it into an Excel worksheet. I've decided to start with tracking just the task name field. If I can get this to work, I can probably get the others to work.

I tried two approaches. First approach was to copy-paste the project data into an excel file so that it was linked. If I made a change in MS project, the same values would change in the linked Excel sheet. I would then use the MS project event handler to call a Sub in excel. That sub would find the cell data that changed and paste it into another sheet in the same workbook (along with other relevant info). I would use the MS project event handler since I couldn't get the excel event handler to notice when a change I made in MS project occurred in the excel sheet. The excel event handler only seems to detect a change when I manually change a value in a cell.

The second approach, and the one that seems the most promising, is described below. I would simply detect when a change was made under a particular field in MS project. Copy the desired line and paste it directly into an excel sheet. I haven't gotten very far with this, but I have a feeling I'm just missing a small detail.

In an MS Project Module:

Dim myobject As New Class1

Sub Initialize_App()
    
    Set myobject.App = MSProject.Application
    Set myobject.Proj = Application.ActiveProject

End Sub

In a Class

Option Explicit

Public WithEvents App As Application
Public WithEvents Proj As Project
Dim TrackchangesP1 As Workbook
Dim stuff As Worksheet
Dim filepath As String


Private Sub App_ProjectBeforeTaskChange(ByVal tsk As Task, ByVal Field As PjField, ByVal NewVal As Variant, Cancel As Boolean)
   
'This event triggers before a task field changes.
 'The entire file path is not shown here, but is present in my code.

    filepath = "C:\...\Track changes P1.xlsm"

     On Error Resume Next
          Set TrackchangesP1 = Workbooks(filepath)
         On Error GoTo 0
    If TrackchangesP1 Is Nothing Then
        ' Workbook is not open. Open it in read-only mode.
        Set TrackchangesP1 = Workbooks.Open(filepath, ReadOnly:=True)
    End If

    If Field = pjTaskName Then
        MsgBox "Task name changed to: " & NewVal
        
     
    'TrackchangesP1.Sheets("Sheet1").test 
'calls a sub in the worksheet which displays a message box, commented 'out for now, this is related to
'my first approach.


    TrackchangesP1.Sheets("Sheet1").Range("N2") = "hello world"
 '''
'I wanted to try to see if I could use a change to a task name in MS 'project to trigger something to be entered into a specific cell in excel. 'It didn't work. There are no errors, but nothing is pasted.
    
    End If
    

Solution

  • This code will track changes in an Excel workbook.

    For the Class1 class module:

    Public WithEvents App As Application
    Public WithEvents Proj As Project
    
    Private Sub Class_Initialize()
    
        Set App = Application
            
    End Sub
    
    Private Sub App_ProjectBeforeTaskChange(ByVal tsk As Task, ByVal Field As PjField _
        , ByVal NewVal As Variant, Cancel As Boolean)
        
        With ChangeLog
            Dim r As Long
            r = .UsedRange.Rows.Count + 1
            .Cells(r, 1) = Now
            .Cells(r, 2) = tsk.UniqueID
            .Cells(r, 3) = tsk.Name
            .Cells(r, 4) = Application.FieldConstantToFieldName(Field)
            .Cells(r, 5) = NewVal
        End With
        
    End Sub
    

    For the Module1 module:

    Public myobject As New Class1
    
    Public xlApp As Excel.Application
    Public TrackchangesP1 As Excel.Workbook
    Public ChangeLog As Excel.Worksheet
    Public stuff As Excel.Worksheet
    
    Public Const filepath As String = "C:\....xlsx"
    
    
    Sub StartEvents()
    
        Set myobject.App = Application
        
        InitExcel
        
    End Sub
    
    Sub InitExcel()
    
        On Error Resume Next
        
        If xlApp Is Nothing Then
            Set xlApp = GetObject(, "Excel.Application")
            If xlApp Is Nothing Then
                Set xlApp = CreateObject("Excel.Application")
            End If
        End If
    
        If Not xlApp.Visible Then
            xlApp.WindowState = xlMinimized
            xlApp.Visible = True
        End If
        
        If TrackchangesP1 Is Nothing Then
            Set TrackchangesP1 = xlApp.Workbooks.Open(filepath)
        End If
        If ChangeLog Is Nothing Then
            Set ChangeLog = TrackchangesP1.Worksheets("Sheet1")
        End If
        
    End Sub
    

    And finally, in the ThisProject module:

    Private Sub Project_Open(ByVal pj As Project)
    
        Call Module1.StartEvents
    
    End Sub
    

    Note: Be sure to save the workbook at some point.