使用任务将具有相同 ID 的 Excel 数据添加到 MS 项目 - VBA

Question

在 Excel 中，我在“A”列中的 ID 编号从第二行开始（第一行 = 标题）。在“T”列中，我在同一行上有该 ID 的持续时间。

在 MS Project 中，我有一个 ID 列和一个空的持续时间列。我想在正确的 ID 行上添加从 excel 到 MS Project 的持续时间。

我想我可以通过使用任务和 For..To 循环来做到这一点。我将需要使用 excel 中的 ID 在 MS Project 中查找任务，然后在 MS Project 中的相应任务中写入来自 excel 的持续时间。到目前为止，在一些帮助下，我拥有的代码是：

'Find duration and assign to ID in Excel
For i = 2 To lastRow
date1 = .Cells(i, 15)
date2 = .Cells(i, 16)
    If .Cells(i, 18).Value = "No" Then
    answer = DateDiff("n", date1, date2)
    .Cells(i, 20) = answer
    End If
durationID = .Cells(i,1).Value
Next i

'Open MS Project and add Duration column
set wb = ActiveWorkBook
Set ws = wb.Sheets("Task_Table1")
Set appProj = CreateObject("Msproject.Application")
appProj.FileOpen "File1.mpp"
Set aProg = appProj.ActiveProject
appProj.Visible = True


lastTask = ActiveProject.Tasks.Count
taskID = ActiveProject.Tasks.ID

'Load Durations into MS Project to appropriate ID task
lastTask = ActiveProject.Tasks.Count
For i = 1 to lastTask
    If taskID = Application.Workbooks("File1").Sheets("Task_Table1").Cells(i, 1).Value Then
    answer.Copy
    appProj.SelectCell.ActiveCell
    end if
Next i

Answer 1

不要将持续时间复制到用户界面中，而是将持续时间直接分配给任务对象。或者（基于下面的评论），更新实际开始和实际完成日期。包含执行这两项操作的代码，但如果您还要更新实际开始和实际完成，则更新持续时间没有意义。

'Open MS Project
Set appProj = CreateObject("MSProject.Application")
appProj.FileOpen "File1.mpp"
Set aProg = appProj.ActiveProject
appProj.Visible = True

'Find duration and assign to task
Dim Duration As Long
Dim tsk as MSProject.Task
With ws
    For i = 2 To lastRow
        date1 = .Cells(i, 15)
        date2 = .Cells(i, 16)
        ' get a reference to the task object using the ID stored in Column A
        Set tsk = aProg.Tasks(.Cells(i, 1).Value)
        ' Update duration 
        If .Cells(i, 18).Value = "No" And IsDate(date1) And IsDate(date2) Then
            TotalMinutes = DateDiff("n", date1, date2)
            WorkingMinutes = appProj.DateDifference(date1, date2)
            .Cells(i, 20) = WorkingMinutes 
            tsk.Duration = WorkingMinutes
        End If
        ' update Actual Start and/or Actual Finish
        If IsDate(date1) Then
            tsk.ActualStart = date1
        End If
        If IsDate(date2) Then
            tsk.ActualFinish = date2
        End If
    Next i
End With

请注意，持续时间包含两个计算。 VBA DateDiff 函数返回两个日期之间的总分钟数，而 MS Project DateDifference 函数返回两个日期之间的工作分钟数。后者可能是您想要使用的。否则 1 天的持续时间（总共 1440 分钟）将变成 3 天的任务（1440 = 3 天 * 8 小时 * 60 分钟/小时）。