你已经把批量导入Excel到MPP的核心功能搞定了，就差最后一步——让整个过程在后台静默运行，不弹出Project窗口对吧？其实问题出在FileOpenEx方法的默认行为上，哪怕你设置了appMSP.Visible = False，导入操作还是会触发窗口显示。下面给你调整后的完整解决方案：

关键修复要点 #

• 刚创建Project应用对象就立刻锁定Visible = False，并且全程保持该状态
• 新增ScreenUpdating = False彻底抑制界面刷新
• 调整文件操作逻辑：先创建空白项目再导入数据，避免打开Excel时激活Project窗口
• 关闭导入时的系统提示，让流程更顺畅

修改后的完整代码 #

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)
    fileExplorer.AllowMultiSelect = False
    
    If fileExplorer.Show = -1 Then
        InputFolderPath = fileExplorer.SelectedItems.Item(1) & "\"
    Else
        InputFolderPath = DefaultInputFolderPath
    End If
    
    Call CreateProjectFromExcelFile(InputFolderPath, DefaultOutputFolderPath)

Exception:
    Select Case Err.Number
        Case 0
            Exit Sub
        Case Else
            MsgBox "UNKNOWN ERROR - Error# " & Err.Number & " : " & Err.Description
    End Select
    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
    Dim appMSP As MSProject.Application
    Dim strFilepath As String
    
    ' 初始化Project应用，优先复用已打开实例，否则新建
    On Error Resume Next
    Set appMSP = GetObject(, "MSProject.Application")
    If Err.Number <> 0 Then
        Set appMSP = CreateObject("MSProject.Application")
    End If
    On Error GoTo 0
    
    ' 核心静默设置：关闭可见性和屏幕更新
    appMSP.Visible = False
    appMSP.ScreenUpdating = False
    appMSP.DisplayAlerts = 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"
    
    ' 遍历目标文件夹中的Excel文件
    myExtension = "*.xlsx"
    myFile = Dir(InputFolderPath & myExtension)
    
    If myFile = "" Then
        MsgBox ("No files available!")
        GoTo ExitCode
    End If
    
    While myFile <> ""
        strFilepath = InputFolderPath & myFile
        oFullFilename = Right(strFilepath, Len(strFilepath) - InStrRev(strFilepath, "\"))
        oFilename = Left(oFullFilename, (InStr(oFullFilename, ".") - 1))
        
        ' 先创建空白项目，再导入Excel数据（避免激活窗口）
        appMSP.FileNew
        appMSP.FileOpenEx Name:=strFilepath, ReadOnly:=False, Merge:=1, _
                          FormatID:="MSProject.ACE", Map:="ImportMap"
        
        ' 保存为MPP并关闭当前项目
        appMSP.FileSaveAs Name:=DefaultOutputFolderPath & oFilename & ".mpp"
        appMSP.FileCloseEx pjDoNotSave
        
        ' 切换到下一个文件
        myFile = Dir
    Wend

ExitCode:
    ' 清理资源：恢复设置并退出Project应用
    If Not appMSP Is Nothing Then
        appMSP.ScreenUpdating = True
        appMSP.DisplayAlerts = True
        appMSP.Quit pjDoNotSave ' 彻底退出，避免后台残留进程
        Set appMSP = Nothing
    End If
    
    If myFile <> "" Then ' 只有成功处理过文件才提示
        MsgBox ("Imported Successfully...")
    End If
    Exit Sub
End Sub

额外注意事项 #

• 确保你的VBA编辑器中已经添加了Microsoft Project Object Library（路径：工具 → 引用）
• 如果仍然有窗口闪现，可以尝试指定Project版本号创建对象，比如CreateObject("MSProject.Application.16")（根据你的Office版本调整）
• 替代方案：除了VBA，还可以考虑用Power Automate实现无代码批量导入，或者用Project Server API（适用于企业级场景），不过VBA依然是轻量化场景下的最优选择

内容的提问来源于stack exchange，提问作者Vignesh Kumar A