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