PDA

View Full Version : Supress File Open Dialogue box when opening MS Project file (MPP) in VBA



mond007
01-16-2014, 08:10 AM
Hi

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