OfficeTips Home || VBA Section || General Section || Download Section || Privacy Policy

Timed application display and termination

Copy the code below into a code module and set a shape to run the macro - TimedAppDisplay. Start the slide show and click on the shape to execute the macro. It will launch the notepad application and then after 7 seconds it will automatically terminate the application and resume the slide show.


' --------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------


Option Explicit
Private Type PROCESS_INFORMATION

hProcess As Long

hThread As Long

dwProcessId As Long

dwThreadId As Long

End Type
Private Type STARTUPINFO

cb As Long

lpReserved As String

lpDesktop As String

lpTitle As String

dwX As Long

dwY As Long

dwXSize As Long

dwYSize As Long

dwXCountChars As Long

dwYCountChars As Long

dwFillAttribute As Long

dwFlags As Long

wShowWindow As Integer

cbReserved2 As Integer

lpReserved2 As Long

hStdInput As Long

hStdOutput As Long

hStdError As Long

End Type
Private Declare Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, _
lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, _
ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long

Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwAccess As Long, ByVal fInherit As Integer, ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long

Const SYNCHRONIZE = 1048576

Const NORMAL_PRIORITY_CLASS = &H20&

Const EXE_PATH_AND_NAME = "Notepad.exe"

Const APP_NAME = "Timed Application Display"
 

Sub TimedAppDisplay()

Dim strucProcInfo As PROCESS_INFORMATION

Dim strucStartInfo As STARTUPINFO

Dim sNull As String

Dim lSuccess As Long

Dim lRetValue As Long
 

On Error GoTo HandleErr
strucStartInfo.cb = Len(strucStartInfo)

lSuccess = CreateProcess(sNull, EXE_PATH_AND_NAME, ByVal 0&, ByVal 0&, 1&, NORMAL_PRIORITY_CLASS, _

ByVal 0&, sNull, strucStartInfo, strucProcInfo)

Sleep 7000 'Sleep for 7 seconds

lRetValue = TerminateProcess(strucProcInfo.hProcess, 0&)

lRetValue = CloseHandle(strucProcInfo.hThread)

lRetValue = CloseHandle(strucProcInfo.hProcess)

DoEvents

' Force the slide show window to the front

Call SetForegroundWindow(FindWindow("screenClass", 0&))

ExitHere:

Exit Sub

HandleErr:

Select Case Err.Number

    Case Else

      MsgBox "Error " & Err.Number & ": " & Err.Description, _

          vbCritical, APP_NAME & " " & "TimedAppDisplay"

End Select

End Sub


Copyright 1999-2018 (c) Shyam Pillai. All rights reserved.