将 Excel 导入到项目中Microsoft

Question

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

我发现以下链接用于设置系统和代码以执行此自动化，但仍然不确定下面的代码是否确切地反映了我的发现。

来源：

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

从包含 n 行的 Excel 文件自动创建 n 个Microsoft项目文件

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

更新

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

但是问题是MPP文件正在打开，它应该发生在后端用户不应该查看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 ProjectsMPP ImportInput"
DefaultOutputFolderPath = "D:Sample ProjectsMPP ImportOutput"
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 Microsoft项目文件。

从 Excel 文件自动制作新的 Microsoft 项目文件非常简单 — 只需一个命令：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 中的工作原理，请参阅将 Excel 数据导入 Project 以了解该过程的工作原理。

注 2：相同的命令用于追加或更新现有计划。