将 Excel 导入 Microsoft Project

Question

我想创建一个自动化工具来导入 Microsoft Project 文件的 excel。我正在尝试在 VBA 中实现这一点（请建议我，如果那里有任何其他选项）并且我研究了一些基本设置的代码。

我找到了以下链接来设置系统和代码来执行此自动化，但仍然不确定下面的代码是否与我的发现完全相同。

来源：

https://www.linkedin.com/pulse/how-automate-ms-project-from-excel-app-malcolm-farrelle?trk=portfolio_article-card_title

Automate creating n Microsoft Project files from an excel file with n rows

我想使用 Mapping 字段编写更新脚本，并且 创建/附加为新项目。

更新

在以下答案的帮助下，我重写了代码以导入多个文件并将其保存为 *.mpp 文件。

但问题是 mpp 文件正在打开，它应该发生在后端用户不应该查看任何东西。

代码：

Private Sub ImportButton_Click()
    On Error GoTo Exception
        
    Dim InputFolderPath As String, DefaultInputFolderPath As String, DefaultOutputFolderPath  As String
    Dim fileExplorer As FileDialog
    
    InputFolderPath = ""
    DefaultInputFolderPath = "D:\Sample Projects\MPP Import\Input\"
    DefaultOutputFolderPath = "D:\Sample Projects\MPP Import\Output\"
    Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)
    
     'To allow or disable to multi select
    fileExplorer.AllowMultiSelect = False
    If fileExplorer.Show = -1 Then 'Any folder is selected
        InputFolderPath = fileExplorer.SelectedItems.Item(1) & "\"
    Else
        InputFolderPath = DefaultInputFolderPath
    End If
       
    Call CreateProjectFromExcelFile(InputFolderPath, DefaultOutputFolderPath)
    
Exception:
    Select Case err.Number   ' Evaluate error number.
        Case 0
            Exit Sub
        Case Else
            MsgBox "UNKNOWN ERROR  - Error# " & err.Number & " : " & err.Description
    End Select
    Exit Sub
ExitCode:
    Exit Sub
End Sub

Public Sub CreateProjectFromExcelFile(InputFolderPath As String, DefaultOutputFolderPath As String)

    Dim myFile As String, myExtension As String, oFullFilename As String, oFilename As String
  

    ' get access to Project application object
    Dim appMSP As MSProject.Application
    On Error Resume Next
    ' see if the application is already open
    Set appMSP = GetObject(, "MSProject.Application")
    If err.Number <> 0 Then
        ' wasn't open, so open it
        Set appMSP = CreateObject("MSProject.Application")
    End If
    ' return to whatever error handling you had
    On Error GoTo 0
    
    appMSP.Visible = False
      
    MapEdit Name:="ImportMap", Create:=True, OverwriteExisting:=True, DataCategory:=0, CategoryEnabled:=True, TableName:="Data", FieldName:="Name", ExternalFieldName:="Task_Name", ExportFilter:="All Tasks", ImportMethod:=0, HeaderRow:=True, AssignmentData:=False, TextDelimiter:=Chr$(9), TextFileOrigin:=0, UseHtmlTemplate:=False, IncludeImage:=False
    MapEdit Name:="ImportMap", DataCategory:=0, FieldName:="Duration", ExternalFieldName:="Duration"
    MapEdit Name:="ImportMap", DataCategory:=0, FieldName:="Start", ExternalFieldName:="Start_Date"
    MapEdit Name:="ImportMap", DataCategory:=0, FieldName:="Finish", ExternalFieldName:="End_Date"
    MapEdit Name:="ImportMap", DataCategory:=0, FieldName:="Resource Names", ExternalFieldName:="Resource_Name"
    MapEdit Name:="ImportMap", DataCategory:=0, FieldName:="Notes", ExternalFieldName:="Remarks"
    ' open the Excel file to import
    Dim strFilepath As String
    'Target File Extension (must include wildcard "*")
    myExtension = "*.xlsx"

    'Target Path with Ending Extention
    myFile = Dir(InputFolderPath & myExtension)
            
            'Loop through each Excel file in folder
    While myFile <> ""
        If (myFile = "") Then
            MsgBox ("No files avaalable!")
            GoTo ExitCode
        End If
        
        'This example will print the file name to the immediate window
         strFilepath = InputFolderPath & myFile
         
         oFullFilename = Right(strFilepath, Len(strFilepath) - InStrRev(strFilepath, "\"))
         oFilename = Left(oFullFilename, (InStr(oFullFilename, ".") - 1))
         
         appMSP.Visible = False
         
         appMSP.FileOpenEx Name:=strFilepath, ReadOnly:=False, Merge:=1, FormatID:="MSProject.ACE", Map:="ImportMap"
         appMSP.FileSaveAs Name:=DefaultOutputFolderPath & oFilename & ".mpp"
        'Set the fileName to the next file
         myFile = Dir
    Wend
    appMSP.FileCloseAllEx pjDoNotSave
    Set appMSP = Nothing
    MsgBox ("Imported Successfully...")
ExitCode:
    Exit Sub
End Sub

Answer 1

我想创建一个自动化工具来导入 excel 微软项目文件。

从 Excel 文件自动创建新的 Microsoft Project 文件非常简单——只需一个命令：FileOpenEx。

您可以通过 Excel 执行以下操作：

Sub CreateProjectFromExcelFile()

    ' get access to Project application object
    Dim appMSP As MSProject.Application
    On Error Resume Next
    ' see if the application is already open
    Set appMSP = GetObject(, "MSProject.Application")
    If Err.Number <> 0 Then
        ' wasn't open, so open it
        Set appMSP = CreateObject("MSProject.Application")
    End If
    ' return to whatever error handling you had
    On Error GoTo 0
    
    appMSP.Visible = True
    
    ' open the Excel file to import
    appMSP.FileOpenEx Name:="C:\<your path here>\SampleNewProjectForImport.xlsx" _
        , Map:="<your map name here>"
    
    appMSP.FileSaveAs Name:="MyProject.mpp"
    
End Sub

使用您的姓名更新 FileOpenEx 行中的路径/名称，根据需要添加错误处理和其他代码，并添加对项目对象库的引用。

注意：如果您不知道如何在 MS Project 中导入，请参阅 Import Excel data into Project 了解有关该过程的工作原理。

注意 2：同一命令用于附加或更新现有计划。