How to check if a PowerPoint file is open? - vba

Question

I am trying to create a MS Word macro to check and see if a specific powerpoint file is open. If it is then I want it to go to next, but if not then open the file.
Public Sub CommandButton1_Click()
Dim pptApp As Object
Dim pptPres As String
'Dim nSlide As PowerPoint.Presentation
Dim folderPath, file As String
folderPath = ActiveDocument.Path & Application.PathSeparator
file = "Huntington_Template.pptx"
Set pptApp = CreateObject("PowerPoint.Application")
If pptApp.presentations(file).Enabled = True Then
GoTo cont
Else
pptApp.Visible = True
pptApp.presentations.Open (folderPath & file)
End If
cont:
End Sub

Answer 1

A minor variation of Steve's code, in case you want to not just test if the presentation is open, but also use it directly:
Function GetPowerpointFileIfOpen(pptApp As Object, sFullname As String) As Object
For Each p In pptApp.Presentations
If p.FullName = sFullname Then
Set GetPowerpointFileIfOpen = p
Exit Function
End If
Next p
End Function
And then you can test if the presentation is open - or open it otherwise:
Set ppt = GetPowerpointFileIfOpen(pptApp, sFullName)
If ppt Is Nothing Then
Set ppt = pptApp.Presentations.Open(sFullName, False)
End If

Answer 2

Add this to your module (aircode, may need debug help):
Function PPTFileIsOpen(pptApp as object, sFullname as string) as boolean
Dim x as long
For x = 1 to pptApp.Presentations.Count
if pptApp.Presentations(x).fullname = sFullname ) Then
PPTFileIsOpen = True
Exit Function
end if
Next
End Function
Then instead of your:
If pptApp.presentations(file).Enabled = True Then
use:
If Not PPTFileIsOpen(pptApp, folderPath & file) Then
' open the file as you're already doing
End If

Answer 3

I have used this function to determine if a workbook is already open it might work for powerpoint.
Public Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
You can then call it by doing something like
Ret = IsWorkBookOpen("C:\Book1.xlsm")
If Ret = True Then
Set wb = Application.Workbooks("C:\Book1.xlsm")
wb.Activate
Else
Set wb = Application.Workbooks.Open("C:\Book1.xlsm")
End If