Prevent Open Resource Pool Dialogue box when opening MPP Project File using VBA

会有一股神秘感。 提交于 2019-12-25 09:25:23

问题


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


来源:https://stackoverflow.com/questions/21165499/prevent-open-resource-pool-dialogue-box-when-opening-mpp-project-file-using-vba

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!