X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
> Vba: Build, Start, And Stop Powerpoint Presentation From Access, Access 2016    
post Feb 24 2020, 01:26 PM

Posts: 1,189
Joined: 17-November 03
From: Hamburg, NY

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.
    '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
        If rs.RecordCount <> 0 Then
            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
        End If
    Set rs = Nothing

    ppPres.SlideShowSettings.LoopUntilStopped = msoCTrue

    'Start the Powerpoint presentation
    '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:
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 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.

When the eagle is away, the crow says, "I am the eagle."
Go to the top of the page
Start new topic
post Feb 24 2020, 03:10 PM

Posts: 1,078
Joined: 12-November 03
From: Iowa Lot

Instead of fCloseApp how about

set ppPres = nothing

(but this probably prompts for a save)
This post has been edited by kfield7: Feb 24 2020, 03:11 PM
Go to the top of the page

Posts in this topic

Custom Search

RSSSearch   Top   Lo-Fi    10th July 2020 - 09:58 AM