CODEWITHSUNDEEP
vbams-wordpowerpoint
James
James

Reputation: 449

How to check if a PowerPoint file is open?

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

Upvotes: 3

Views: 7104

Answers (3)

Peter T.
Peter T.

Reputation: 3325

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

Upvotes: 4

user3271518
user3271518

Reputation: 628

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

Upvotes: 0

Steve Rindsberg
Steve Rindsberg

Reputation: 14809

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

Upvotes: 2

Related Questions