Question

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

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

我很感激一些帮助。提前谢谢。

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

Answer 1

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

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

使用VBA打开MPP项目文件时阻止打开资源池对话框

1 个答案: