使用VBA打开MPP项目文件时，阻止“打开资源池对话框"框 [英] Prevent Open Resource Pool Dialogue box when opening MPP Project File using VBA

问题描述

我有一些用于打开Microsoft Project文件的代码，但是尽管做出了所有努力，但我仍无法阻止打开对话框的出现或自动答复它.

I have some code that I am using to Open a Microsoft Project file but despite all efforts I have been unable to prevent the opening dialogue box from appearing or auto answering it.

我尝试了 Application.EnableEvents = False ， Application.DisplayAlaerts = False 和 .FileOpenEx 都无济于事.

I have tried Application.EnableEvents = False, Application.DisplayAlaerts = False and .FileOpenEx all to no avail.

我将不胜感激.预先感谢.

I would appreciate some help. Thanks in advance.

Public Sub extract_data()

Dim appProj As MSProject.Application
Dim aProg As MSProject.Project
Dim app
Dim mppApp As MSProject.Application
Dim Tasks As Tasks
Dim mpp_file_name As String
Dim j As Integer

    Set destination_ws = ThisWorkbook.Worksheets("Imported Vehicles")
    destination_ws.Cells.Clear

    file_location = ThisWorkbook.Worksheets("Control Panel").Range("F19").Value
    file_name = ThisWorkbook.Worksheets("Control Panel").Range("F20").Value
    file_location_and_name = file_location & file_name

    Set appProj = CreateObject("Msproject.Application")

    '---------------------------------------------------------------------
    'Set appProj = GetObject(, "MSProject.Application")
    'If IsEmpty(appProj) Then Set appProj = CreateObject("MSProject.Application")
    'appProj.FileOpenEx Name:=file_location_and_name, ReadOnly:=True
    '---------------------------------------------------------------------

    Application.EnableEvents = True
    Set mppApp = CreateObject("msproject.application")

    mppApp.DisplayAlerts = False
    mppApp.FileOpen Name:=file_location_and_name, ReadOnly:=True ' Opens file as Read Only

    mppApp.DisplayAlerts = False
    Application.EnableEvents = True

    '--------------------------- WAIT FOR IE TO CATCH UP --------------------------
    newHour = Hour(Now())
    newMinute = Minute(Now())
    newSecond = Second(Now()) + 3
    waitTime = TimeSerial(newHour, newMinute, newSecond)
    Application.Wait waitTime
    '------------------------------------------------------------------------------

    Set aProg = mppApp.ActiveProject
    'aProg.Visible = True

    Application.SendKeys "{TAB}"   'Enter to OK
    Application.SendKeys "^~"   'Enter yes to OK

    'COPY DATA ACROSS code

    Set mpApp = Nothing

    DoEvents

    MsgBox "Data from MS Project File Copied", vbInformation

End Sub

推荐答案

您无需切换DisplayAlerts，只需将文件打开行更改为此:

You don't need to toggle DisplayAlerts, just change your file open line to this:

mppApp.FileOpen Name:=file_location_and_name, ReadOnly:=True, openPool:=pjDoNotOpenPool

这篇关于使用VBA打开MPP项目文件时，阻止“打开资源池对话框"框的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！