将Excel导入Microsoft Project [英] Import Excel into Microsoft Project

问题描述

我想创建一个自动化工具来导入Excel for Microsoft Project文件.我正在尝试在VBA中实现这一目标(如果有其他选择，请建议我)，我研究了一些用于基本设置的代码.

I would like to create an automated tool to import the excel for Microsoft Project file. I am trying to achieve this in VBA (please suggest me, If any other options there) and i researched some code for basic setup.

我找到了以下链接来设置系统和代码以实现这种自动化，但仍然不确定下面的代码是否与我的发现完全一致.

I found following link to setup the system and code to do this automation but still not sure below code is exact my findings or not.

来源:

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

自动创建n具有n行的excel文件中的Microsoft Project文件

我想使用映射"字段编写更新脚本，然后创建/添加为新项目.

I would like write the update script using Mapping field and create/append as new projects.

更新

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

With help of below answer, I have rewritten the code to import the multiple files and saved it as *.mpp file.

但是问题是mpp文件正在打开，应该在后端用户不应该查看内容的情况下发生.

but the problem is mpp file is opening and it should happen in the backend user should not view naything.

代码:

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

推荐答案

我想创建一个自动化工具来导入excelMicrosoft Project文件.

I would like to create an automated tool to import the excel for Microsoft Project file.

从Excel文件自动制作新的Microsoft Project文件非常容易，它是一个命令:

Automating making a new Microsoft Project file from an Excel file is very easy—it's a single command: FileOpenEx.

这是从Excel中执行操作的方法:

Here is how you can do it from 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行中的路径/名称，根据需要添加错误处理和其他代码，并添加对Project Object库的引用.

Update the paths/names in the FileOpenEx line with your names, add error handling and other code as you want, and add a reference to the Project Object library.

注意:如果您不知道MS Project中的导入方式，请参见

Note: If you don't know how importing works in MS Project, see Import Excel data into Project for an explanation of how the process works.

注2:使用同一命令可以追加或更新现有计划.

Note 2: The same command is used to append to or update an existing schedule.

这篇关于将Excel导入Microsoft Project的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！