DelayedEvent.cls #1

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "DelayedEvent"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' Class to workaround PowerPoint problems (not allow to execute Close method on
' a presentation if we are in the PresentationOpen event handler of the application
' so this class allows us to fire off an event a short time later after exiting the
' event handler.

Private Enum DelayedEventType
    CloseEvent = 1
    OpenEvent = 2
    RenameEvent = 3
    RevertEvent = 4
    SyncEvent = 5
    SaveAsEvent = 6
    MenuPopup = 7
    ShellExecute = 8
End Enum

Private m_EventType As DelayedEventType

Private m_App As Object     ' Word/Excel/PowerPoint
Private m_OfficeApp As OfficeApp
Private m_time As Date
Private m_Done As Boolean  ' Flag to only execute event once

' For Revert
Private m_Added As Boolean

' For Open event
Private m_FileName As String
Private m_ReadOnly As Boolean

' For Rename event
Private m_OldFilename As String
Private m_NewFilename As String

' For menu popup
Private m_Menu As CommandBar
Private m_Top As Integer
Private m_Left As Integer

Private Sub Init(App As Object, OApp As OfficeApp, EventType As DelayedEventType)

    Set m_App = App
    Set m_OfficeApp = OApp
    m_EventType = EventType
    m_time = Now
    m_Done = False

End Sub

' The appropriate initialisation methods for the class
Public Sub InitClose(App As Object, OApp As OfficeApp)
    Init App, OApp, CloseEvent
End Sub

Public Sub InitOpen(App As Object, OApp As OfficeApp, FileName As String, bReadOnly As Boolean)
    Init App, OApp, OpenEvent
    m_FileName = FileName
    m_ReadOnly = bReadOnly
End Sub

Public Sub InitSync(App As Object, OApp As OfficeApp, FileName As String)
    Init App, OApp, SyncEvent
    m_FileName = FileName
End Sub

Public Sub InitSaveAs(App As Object, OApp As OfficeApp, FileName As String)
    Init App, OApp, SaveAsEvent
    m_FileName = FileName
End Sub

Public Sub InitRename(App As Object, OApp As OfficeApp, OldName As String, NewName As String)
    Init App, OApp, RenameEvent
    m_OldFilename = OldName
    m_NewFilename = NewName
End Sub

Public Sub InitRevert(App As Object, OApp As OfficeApp, Added As Boolean, FileName As String)
    Init App, OApp, RevertEvent
    m_Added = Added
    m_FileName = FileName
End Sub

Public Sub InitMenuPopup(App As Object, OApp As OfficeApp, Menu As CommandBar, Left As Integer, Top As Integer)
    Init App, OApp, MenuPopup
    Set m_Menu = Menu
    m_Left = Left
    m_Top = Top
End Sub

Public Sub InitShellExecute(App As Object, OApp As OfficeApp, LocalFileName As String)
    Init App, OApp, ShellExecute
    m_FileName = LocalFileName
End Sub

' This carries out the appropriate event
Public Sub DoEvent()

    Dim T As Tracker: Set T = GStackTrace.Enter(TypeName(Me), "DoEvent")
    If Not m_Done Then
        m_Done = True
        If m_EventType = CloseEvent Then
            m_OfficeApp.CloseCurrDocImmediate m_ReadOnly
        ElseIf m_EventType = OpenEvent Then
            m_OfficeApp.OpenFileImmediate m_FileName, m_ReadOnly
        ElseIf m_EventType = RenameEvent Then
            m_NewFilename = RenameFile(m_OldFilename, m_NewFilename)
        ElseIf m_EventType = RevertEvent Then
            m_OfficeApp.RevertImmediate m_Added, m_FileName
        ElseIf m_EventType = SyncEvent Then
            m_OfficeApp.SyncFileImmediate m_FileName
        ElseIf m_EventType = SaveAsEvent Then
            m_OfficeApp.SaveAsCurrDocImmediate m_FileName
        ElseIf m_EventType = MenuPopup Then
            m_Menu.ShowPopup m_Left, m_Top
        ElseIf m_EventType = ShellExecute Then
            m_OfficeApp.ShellExecuteImmediate m_FileName
        Else
            err.Raise 1001, , "Invalid event type!" & CStr(m_EventType)
        End If
        
    End If
    
End Sub