Prevent Open Resource Pool Dialogue box when openi

问题:

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.

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

回答1:

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