Printable Version of Topic

Click here to view this topic in its original format

UtterAccess Forums _ Access Q and A _ Vba: Build, Start, And Stop Powerpoint Presentation From Access

Posted by: dhapp Feb 24 2020, 01:26 PM

I have built a MS Access application that builds a customize-able PowerPoint presentation for in-house information.
The app creates specific slides by pulling data from a variety of back end files. The code is either run directly or it is run using a a timing system so that the presentation stops for several hours, then collect the data again to keep things up to date.

This has worked fine for several years, but somewhere along the way it changes its behavior a bit.
When originally built the code would tell PP to stop and close, it would. At some point PP stopped closing and sits as an open instance of PP. I have to manually click each started instance, tell it to close, and indicate to Not Save.

All I need is updated code that will close PP without saving the presentation.

Here is the code where I start and stop the PP presentation.

CODE
    'Open up an instance of PowerPoint.
    Set ppObj = New PowerPoint.Application
    Set ppPres = ppObj.Presentations.Add
    
    Dim strCallText As String
    Dim strSlideName As String
    Dim strProcedureName As String
    Dim strLocalVariable As String
    Dim lSlideID As Long
    Dim vDuration As Variant

    Dim rs As DAO.Recordset
    strTrace = "Open recordset quSlideShow"
    Set rs = CurrentDb.OpenRecordset("quSlideShow", dbOpenDynaset)
    'quSlideShow:   SlideName   SlideDuration   SlideID     SeqVal  SlideType   CompactName
    'rs![fieldname]
        If rs.RecordCount <> 0 Then
            rs.MoveFirst
            While Not rs.EOF
                lSlideID = rs![SlideID]
                Select Case rs![SlideType]
                    Case 1      'Data
                        strProcedureName = rs![CompactName]
                        strLocalVariable = rs![SlideName]
                    Case 2      'Message
                        strProcedureName = "ShowMessage"
                        strLocalVariable = rs![SlideName]
                    Case 3      'Picture
                        strProcedureName = "ShowPicture"
                        strLocalVariable = rs![SlideName] & ".jpg"
                End Select
                vDuration = rs![SlideDuration]
                Application.Run strProcedureName, strLocalVariable, lSlideID, vDuration
                rs.MoveNext
            Wend
        End If
    rs.Close
    Set rs = Nothing

    ppPres.SlideShowSettings.LoopUntilStopped = msoCTrue

    'Start the Powerpoint presentation
    ppPres.SlideShowSettings.Run
    
    'Let the presentation run for number of seconds (in variable lSecToRunPres)
    PauseApp lSecToRunPres
    
    'Close PowerPoint which is 'screenClass'
    fCloseApp "screenClass"     '<<<===This is where I need updated code.
    PauseApp 2


Here is the code that does application control:
CODE
Option Compare Database
Option Explicit

'************** Code Start ***************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed, except as part of an application.
' You are free to use it in any application, provided the copyright notice is left unchanged.
' Code Courtesy of Dev Ashish
'
Private Const WM_CLOSE = &H10
Private Const INFINITE = &HFFFFFFFF

Private Declare PtrSafe Function apiPostMessage _
    Lib "user32" Alias "PostMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long

Private Declare PtrSafe Function apiFindWindow _
    Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassname As String, _
    ByVal lpWindowName As String) _
    As Long
    
Private Declare PtrSafe Function apiWaitForSingleObject _
    Lib "kernel32" Alias "WaitForSingleObject" _
    (ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) _
    As Long
    
Private Declare PtrSafe Function apiIsWindow _
    Lib "user32" Alias "IsWindow" _
    (ByVal hwnd As Long) _
    As Long
        
Private Declare PtrSafe Function apiGetWindowThreadProcessId _
    Lib "user32" Alias "GetWindowThreadProcessId" _
    (ByVal hwnd As Long, _
    lpdwProcessID As Long) _
    As Long
        
Function fCloseApp(lpClassname As String) As Boolean
    'Usage Examples:
    '   To close Calculator:
    '       fCloseApp("SciCalc")
    '
    Dim lngRet As Long, hwnd As Long, pID As Long

    hwnd = apiFindWindow(lpClassname, vbNullString)
Debug.Print hwnd, lpClassname, vbNullString
    If (hwnd) Then
        lngRet = apiPostMessage(hwnd, WM_CLOSE, 0, ByVal 0&)
        Call apiGetWindowThreadProcessId(hwnd, pID)
        Call apiWaitForSingleObject(pID, INFINITE)
        fCloseApp = Not (apiIsWindow(hwnd) = 0)
    End If
End Function
'************* Code End ***************

Any suggestions appreciated.
Doug

Posted by: kfield7 Feb 24 2020, 03:10 PM

Instead of fCloseApp how about

ppPres.close
set ppPres = nothing

(but this probably prompts for a save)

Posted by: dhapp Feb 24 2020, 03:25 PM

Your suggestion passed test #1.
I substituted your code and ran a test presentation of a few slides. I let it run for a few cycles then stopped it using ESC on the keyboard. It showed an empty PP screen then closed. So good news.

I will now put this on the server and see how it works in that environment and using the timer version of the code.

Thanks.

Posted by: kfield7 Feb 24 2020, 04:43 PM

You might also need

ppObj.close
set ppObj=nothing

i.e., close the presentation, then close the application. Otherwise, you might have extraneous instances of PowerPoint hanging around until reboot.