How to detect when video generation has completed

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

When you create a video, the actual creation process runs in the background. You can see the creation progress on the status bar.

When you try to create this video via automation the CreateVideo call is asynchronous. Your code will get control back as soon as the video is put in the queue for video creation. So how do you detect when the video creation state?

The answer is poll the CreateVideoStatus property on the presentation.

The following return values give you sufficient information about the task.

Const ppMediaTaskStatusNone = 0

Const ppMediaTaskStatusInProgress = 1

Const ppMediaTaskStatusQueued = 2

Const ppMediaTaskStatusDone = 3

Const ppMediaTaskStatusFailed = 4

Supported versions: PowerPoint 2010+

Option Explicit

'VBA7 declarations so that they work on Office 64-bit editions too

Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr

Dim TimerId As Long

Sub Start()

   On Error GoTo Start_Error

   Call ActivePresentation.CreateVideo("c:\temp\testvideo.wmv", True, 5, 720, 30, 85)
  TimerId = SetTimer(0, 0, 1000, AddressOf TimerProc)

   On Error GoTo 0
  Exit Sub

Start_Error:
    If TimerId <> 0 Then TimerId = KillTimer(0, TimerId)
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Start"

End Sub

Sub TimerProc(ByVal hwnd As Long, _
                    ByVal uMsg As Long, _
                    ByVal idEvent As Long, _
                    ByVal dwTime As Long)

Select Case ActivePresentation.CreateVideoStatus

    Case ppMediaTaskStatusNone
        Debug.Print "No task running"
        Call EndTimer

    Case ppMediaTaskStatusInProgress
        Debug.Print "Video creation in progress"

    Case ppMediaTaskStatusQueued
        Debug.Print "Video creation queued"

    Case ppMediaTaskStatusDone
        Debug.Print "Video creation complete"
        Call EndTimer

    Case ppMediaTaskStatusFailed
        Debug.Print "Video creation failed"
        Call EndTimer

End Select

End Sub

Sub EndTimer()
TimerId = KillTimer(0, TimerId)
End Sub