Excel VBA：将数据从 MS Project 复制到 Excel 并返回

截至目前，一切正常，直到我必须从 MSP 复制信息 到 Excel 并返回。我试图使用标准的 excel 逻辑，但似乎 MSP必须以另一种方式处理。

是的，由于 MS Project 的用途与 Excel 不同，因此它具有不同的对象模型，并且 Excel 逻辑不适用。要记住的一件关键事情是，Project 中的视图与 Excel 中的不同工作表完全不同。

Project 的基础是任务，它们可以在不同的视图中显示，以不同的顺序显示，经过筛选等。将数据从 Project 复制到 Excel 时，尽量不要将其视为将范围从一个 Excel 文件复制到另一个 Excel 文件。相反，逐个复制任务，或者如果性能有问题，则创建任务数组并将数组复制到 Excel。

下面的代码从项目中复制任务数据，并将其放入 Excel 文件的 A 列和 B 列中。然后，将 C 列中的数据复制回任务。

Private Sub DatenAktualisieren()


    Dim ProjApp As MSProject.Application ' Microsoft Project Application
    Dim ProjFile As Variant ' Path to the Microsoft Project file
    Dim ProjSheet As MSProject.Project ' Microsoft Project Worksheet
    Dim ExcelBook As Workbook
    
        
    ' Paths to MS Project and Excel files
    ' standard drive is C, this function has to be pointed to the destination: drive X, where all project files are located
    ChDrive "X"
    ChDir "X:<filepath>"
    ProjFile = Application.GetOpenFilename(FileFilter:="Project Files (*.mpp), *.mpp", _
        Title:="MS Project Datei auswählen", _
        MultiSelect:=False)
    
    If ProjFile = "False" Then 'GetOpenFilename returns boolean, not an object/string/integer, as one might   think!
        Exit Sub
    End If

    ' Open the MS Project file
    If ProjFile <> False Then
    
         ' if Project is already open, get a reference to it, otherwise open it
        On Error Resume Next
        Set ProjApp = GetObject(, "MSProject.Application")
        If ProjApp Is Nothing Then
            Set ProjApp = CreateObject("Msproject.Application")
        End If
        ProjApp.Visible = True
   
        ProjApp.DisplayAlerts = False
        
        ProjApp.FileOpen Name:=ProjFile
        Set ProjSheet = ProjApp.ActiveProject
        
        Set ExcelBook = ThisWorkbook
        Dim ExcelSheet As Worksheet
        Set ExcelSheet = ExcelBook.Sheets(1)
        ExcelSheet.Range("A1:B5000").Clear
        
        ' copy data from Project to Excel
        Dim fldProcessCode As Long
        fldProcessCode= ProjApp.FieldNameToFieldConstant("Process Code")
        Dim r As Long
        r = 1
        Dim tsk As Task
        For Each tsk In ProjSheet.Tasks
            r = r + 1
            ExcelSheet.Cells(r, 1) = tsk.UniqueID               ' pick the field you want to put in Column A
            ExcelSheet.Cells(r, 2) = tsk.GetField(fldProcessCode)  ' pull value from custom field 
        Next tsk
            
        'Copy new Data back from Excel to MSP
        ExcelSheet.Calculate
        r = 1
        For Each tsk In ProjSheet.Tasks
            r = r + 1
            tsk.Text1 = ExcelSheet.Cells(r, 3)      ' pick the Task field where Column C data should go
        Next tsk
        
    End If
    
End Sub

提示 1：在自动执行其他应用程序（在本例中为 MS Project）时，请始终立即将 Visible 属性设置为 True，以便用户可以响应意外的弹出消息。

提示 2：考虑为项目文件使用不同的变量名称，因为“工作表”在 MS Project 中没有意义。通常，“proj”或“project”可以单独使用，也可以用作前缀或后缀。

提示 3：若要从自定义任务字段（企业字段或具有自定义名称且基础字段名称未知的本地字段）获取值，请使用应用程序对象的 FieldNameToFieldConstant 方法首先获取 FieldID，然后使用 Task 对象的 GetField 方法获取值。