OfficeApp.cls #2

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "OfficeApp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' Interface for Office Applications
' Copyright (c) 2000-2005 Vaccaperna Systems Ltd

' The following stores an object of type Word/Excel/PowerPoint.Application
Private m_App As Object

' Flag used to indicate we are closing file as opposed to user
' Read when handling Close event (SubmitOnClose)
Public m_FileClosing As Boolean

' Save up some actions for later execution (in PowerPoint).
Private m_DelayedEventHandler As DelayedEventHandler

Private Const P4File = 0
Private Const P4Revision = 1
Private Const P4Author = 2
Private Const P4Id = 3
Private Const P4Header = 4
Private Const P4Date = 5
Private Const P4Datetime = 6
Private Const P4Server = 7
Private Const P4PrevChange = 8
Private Const P4LastKeyword = 8    ' Make sure this is the last index used

Dim m_Keywords(0 To P4LastKeyword) As String

' Save for later use
Public Sub Initialize(App As Object)
    Set m_App = App
    
    m_Keywords(P4File) = "P4File"
    m_Keywords(P4Revision) = "P4Revision"
    m_Keywords(P4Author) = "P4Author"
    m_Keywords(P4Id) = "P4Id"
    m_Keywords(P4Header) = "P4Header"
    m_Keywords(P4Date) = "P4Date"
    m_Keywords(P4Datetime) = "P4Datetime"
    m_Keywords(P4Server) = "P4Server"
    m_Keywords(P4PrevChange) = "P4PrevChange"
    
End Sub

Public Function GetActiveWindowHandle() As Long
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetActiveWindowHandle")
    ' Wildcard class names to look for
    Const WordClass = "OpusApp"
    Const PowerpointClass = "PP*FrameClass"
    Const ExcelClass = "XLMAIN"
    Dim hwnd As Long
    Dim WindowName As String
    Dim ClassName As String
    Dim i As Integer
    
    WindowName = "*"
    If Not NoCurrDoc() Then
        If Len(m_App.ActiveWindow.Caption) > 0 Then
            WindowName = "*" & m_App.ActiveWindow.Caption & "*"
            ' Need to remove the following string which can cause an error in like pattern
            ' matching - occurs for PowerPoint if nothing else.
            i = InStr(1, WindowName, "[read-only]", vbTextCompare)
            If i > 0 Then
                WindowName = Left$(WindowName, i - 1) & Mid$(WindowName, i + 12 - 1)
            End If
        End If
    End If
    If IsWord() Then
        ClassName = WordClass
    ElseIf IsExcel() Then
        ClassName = ExcelClass
    Else
        ClassName = PowerpointClass
    End If
    hwnd = FindWindowHandle(WindowName, ClassName)
    If hwnd <> 0 Then 'we found it
        If GStacker.Tracing Then
            GStacker.TraceMsg "Found window handle for " & WindowName
        End If
        GetActiveWindowHandle = hwnd
    Else 'we went through all the windows and didn't find it.
        If GStacker.Tracing Then
            GStacker.TraceMsg "Failed to find window handle for " & WindowName
        End If
        GetActiveWindowHandle = 0
    End If

End Function

Public Function NoCurrDoc() As Boolean
    ' True if there isn't an active document

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "NoCurrDoc")

    If IsExcel() Then
        NoCurrDoc = (m_App.Workbooks.Count = 0)
    ElseIf IsWord() Then
        NoCurrDoc = (m_App.Documents.Count = 0)
    Else
        NoCurrDoc = (m_App.Presentations.Count = 0)
    End If

End Function

Public Function EmbeddedApp() As Boolean
    ' Check to see if embedded in Internet Explorer or similar
    Dim path As String

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "EmbeddedApp")

    EmbeddedApp = False
    If NoCurrDoc() Then Exit Function

    path = GetCurrDocPath

    ' Only valid paths are: "C:" or similar or "\\computer" or similar
    ' Assume that other paths (e.g. "http://www." etc) mean we are embedded
    If (Mid(path, 2, 1) = ":" And IsLetter(Left(path, 1))) Or (Left(path, 2) = "\\") Then
        EmbeddedApp = False
    Else
        EmbeddedApp = True
    End If

End Function

Public Function EmbeddedDocument() As Boolean
    ' Check to see if Excel Worksheet embedded in Word doc or similar
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "EmbeddedDocument")
    Dim Name As String
    Dim path As String

    EmbeddedDocument = False
    If GStacker.Tracing Then
        GStacker.TraceMsg "EmbeddedDoc: Enter - app = " & m_App.Name
    End If
    If NoCurrDoc() Then Exit Function

    ' The best we have come up with so far is to search for special name in docname
    ' Errors indicate a property problem - pretend the doc is embedded as a result
    On Error Resume Next
    Name = GetCurrDocName
    path = GetCurrDocPath
    If err.Number <> 0 Then
        GStacker.Clear
        err.Clear
        If GStacker.Tracing Then
            GStacker.TraceMsg "EmbeddedDoc: failed - app = " & m_App.Name
        End If
        Exit Function
    End If
    On Error GoTo 0

    If GStacker.Tracing Then
        GStacker.TraceMsg "EmbeddedDoc: " & Name & "/" & path
    End If

    If Len(path) <> 0 Then Exit Function

    Dim SearchString(4) As String
    Dim i As Integer
    SearchString(1) = "Document in "
    SearchString(2) = "Slide in "
    SearchString(3) = "Presentation in "
    SearchString(4) = "Worksheet in "

    For i = 1 To 4
        If Left$(Name, Len(SearchString(i))) = SearchString(i) Then
            EmbeddedDocument = True
        End If
    Next

End Function


Private Function IsLetter(ByVal Text As String)
    Dim i As Long
    For i = 1 To Len(Text)
        Select Case Asc(Mid$(Text, i, 1))
            Case 65 To 90, 97 To 122
                ' uppercase or lowercase letter
            Case Else
                ' exit if anything else
                Exit Function
        End Select
    Next
    ' return True
    IsLetter = True
End Function

Private Sub LowerCaseDriveLetter(path As String)
    ' Make sure initial drive letter is lowercase
    Dim drive As String
    
    If Mid$(path, 2, 1) = ":" Then
        drive = Left$(path, 1)
        If (Asc(drive) >= Asc("A")) And (Asc(drive) <= Asc("Z")) Then
            drive = LCase(drive)
            path = drive & Mid$(path, 2)
        End If
    End If
    
End Sub

Public Function GetCurrDocPath() As String
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetCurrDocPath")
    On Error GoTo Error_Block
    If IsExcel() Then
        GetCurrDocPath = GetActiveWorkbook.path
    ElseIf IsWord() Then
        GetCurrDocPath = GetActiveDocument.path
    Else
        GetCurrDocPath = GetActivePresentation.path
    End If
    
    If IsVersion97() Then
        GetCurrDocPath = GetFullPathName(GetCurrDocPath)
    End If
    LowerCaseDriveLetter GetCurrDocPath
    Exit Function
    
Error_Block:
    GStacker.Clear
    err.Clear
End Function

Public Function GetCurrDocName() As String
    Dim FullPath As String
    Dim Result As String

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetCurrDocName")
    On Error GoTo Error_Block
    If IsExcel() Then
        Result = GetDocNameWithExtension(GetActiveWorkbook.Name, GetActiveWorkbook.FullName)
    ElseIf IsWord() Then
        Result = GetDocNameWithExtension(GetActiveDocument.Name, GetActiveDocument.FullName)
    Else
        Result = GetDocNameWithExtension(GetActivePresentation.Name, GetActivePresentation.FullName)
    End If
    GetCurrDocName = Result
    LowerCaseDriveLetter GetCurrDocName
    Exit Function
    
Error_Block:
    GStacker.Clear
    err.Clear
End Function

' Ensure that we never get document names without .ppt, .doc etc
Private Function GetDocNameWithExtension(ByVal Docname As String, ByVal PathName As String) As String

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetDocNameWithExtension")
    Dim ind As Integer
    Dim bFound As Boolean

    bFound = False
    PathName = ConvertSlashes(PathName)
    Docname = ConvertSlashes(Docname)
    GetDocNameWithExtension = Docname
    If InStr(1, Docname, ".") = 0 Then
        ind = Len(PathName)
        While Not bFound And ind > 0
            If Mid$(PathName, ind, 1) = "\" Then
                GetDocNameWithExtension = Mid$(PathName, ind + 1)
                bFound = True
            End If
            ind = ind - 1
        Wend
    End If

End Function

' combine both of the above functions
Public Function GetCurrDocPathname() As String

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetCurrDocPathname")
    GetCurrDocPathname = GetCurrDocPath() & "\" & GetCurrDocName()

End Function

Private Function GetCustomProperties() As Object
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetCustomProperties")
    
    If IsExcel() Then
        Set GetCustomProperties = GetActiveWorkbook.CustomDocumentProperties
    ElseIf IsWord() Then
        Set GetCustomProperties = GetActiveDocument.CustomDocumentProperties
    Else
        Set GetCustomProperties = GetActivePresentation.CustomDocumentProperties
    End If
    
End Function

Public Sub KeywordPropertiesUpdate(bSubmitting As Boolean)
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "KeywordPropertiesUpdate")
    Dim cdp As Object
    Dim f As Fstat
    Dim ID As String
    Dim rev As String
    Dim p4 As P4COM.p4
    
    Set p4 = NewP4
    If Not KeywordPropertiesExist Then
        Exit Sub
    End If
    
    Set cdp = GetCustomProperties

    Set f = New Fstat
    f.Initialize Me ', DocPath:=DocPathname
    f.Run
    
    If bSubmitting Then
        rev = CStr(CInt(f.HeadRev) + 1)
    Else
        rev = f.HeadRev
    End If
    ID = f.DepotFile & "#" & rev
    KeywordUpdate m_Keywords(P4File), f.DepotFile
    KeywordUpdate m_Keywords(P4Author), f.ActionOwner
    KeywordUpdate m_Keywords(P4PrevChange), f.HeadChange
    KeywordUpdate m_Keywords(P4Server), p4.port
    KeywordUpdate m_Keywords(P4Id), ID
    KeywordUpdate m_Keywords(P4Header), ID
    KeywordUpdate m_Keywords(P4Revision), rev
    If KeywordExists(m_Keywords(P4Date)) Or KeywordExists(m_Keywords(P4Datetime)) Then
        Dim Datetime As String
        Datetime = GetServerDatetime
        KeywordUpdate m_Keywords(P4Date), Left$(Datetime, 10)
        KeywordUpdate m_Keywords(P4Datetime), Datetime
    End If
    
End Sub

Private Function GetServerDatetime() As String
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "KeywordPropertiesCreate")
    Dim p4 As P4COM.p4
    Dim InfoArr() As String
    Dim i As Integer
    
    Set p4 = NewP4
    p4.ExceptionLevel = 0
    p4.Connect
    InitP4 p4
    InfoArr = p4.Run("info")
    
    ' Server date: 2007/06/27 08:24:15 -0700 PDT
    ' Server date: 2007/06/27 16:25:48 +0100 GMT Daylight Time
    For i = LBound(InfoArr) To UBound(InfoArr)
        If Left$(InfoArr(i), 12) = "Server date:" Then
            GetServerDatetime = Mid$(InfoArr(i), 14)
            Exit Function
        End If
    Next
    GetServerDatetime = Format$(Now(), "yyyy/MM/dd HH:mm:ss")
End Function

Private Sub KeywordUpdate(keyword As String, newval As String)
    If KeywordExists(keyword) Then
        Dim cdp As Object
        Set cdp = GetCustomProperties
        cdp(keyword).Value = newval
    End If
End Sub

Public Sub KeywordPropertiesCreate()
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "KeywordPropertiesCreate")
    Dim cdp As Object
    Dim i As Integer
    
    If KeywordPropertiesExist Then
        Exit Sub
    End If
    
    ' Add empty values and then call sub to put in proper values
    Set cdp = GetCustomProperties
    For i = 0 To P4LastKeyword
        cdp.Add Name:=m_Keywords(i), Value:="", Type:=msoPropertyTypeString, LinkToContent:=False
    Next
    KeywordPropertiesUpdate False
    
End Sub

Public Function KeywordPropertiesExist() As Boolean
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "KeywordPropertiesExist")
    Dim i As Integer
    
    KeywordPropertiesExist = False
    For i = 0 To P4LastKeyword
        If KeywordExists(m_Keywords(i)) Then
            KeywordPropertiesExist = True
            Exit Function
        End If
    Next
    
End Function

Private Function KeywordExists(keyword As String) As Boolean

    Dim cdp As Object
    Dim i As Integer
    
    KeywordExists = False
    Set cdp = GetCustomProperties
    For i = 1 To cdp.Count
        If keyword = cdp(i).Name Then
            KeywordExists = True
            Exit Function
        End If
    Next

End Function

Public Sub KeywordPropertiesDelete()
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "KeywordPropertiesDelete")
    Dim cdp As Object
    Dim i As Integer
    
    Set cdp = GetCustomProperties
    On Error Resume Next
    For i = 0 To P4LastKeyword
        cdp(m_Keywords(i)).Delete
    Next

End Sub

' Find all fields and update them in the document
Public Sub KeywordPropertiesFieldsUpdate()
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "KeywordPropertiesFieldsUpdate")
    Dim oStory As Range
    Dim oField As Field
    
    If Not IsWord() Then
        Exit Sub
    End If
    
    ' Go carefully through only updating certain fields
    
    For Each oStory In ActiveDocument.StoryRanges
        For Each oField In oStory.Fields
            If oField.Type = wdFieldDocProperty Then
                oField.Update
            End If
        Next

        ' Now look through headers and footers etc
        If oStory.StoryType <> wdMainTextStory Then
            While Not (oStory.NextStoryRange Is Nothing)
                Set oStory = oStory.NextStoryRange
                For Each oField In oStory.Fields
                    If oField.Type = wdFieldDocProperty Then
                        oField.Update
                    End If
                Next
            Wend
        End If
    Next
    Set oStory = Nothing
End Sub

Public Function GetCurrDocSaved() As Boolean

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetCurrDocSaved")
    If IsExcel() Then
        GetCurrDocSaved = GetActiveWorkbook.Saved
    ElseIf IsWord() Then
        GetCurrDocSaved = GetActiveDocument.Saved
    Else
        GetCurrDocSaved = GetActivePresentation.Saved
    End If

End Function

Public Function GetCurrDocReadonly() As Boolean

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetCurrDocReadonly")
    If IsExcel() Then
        GetCurrDocReadonly = GetActiveWorkbook.ReadOnly
    ElseIf IsWord() Then
        GetCurrDocReadonly = GetActiveDocument.ReadOnly
    Else
        GetCurrDocReadonly = GetActivePresentation.ReadOnly
    End If

End Function

Public Function GetCurrDocReadonlyRecommended() As Boolean

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetCurrDocReadonlyRecommended")
    If IsExcel() Then
        GetCurrDocReadonlyRecommended = GetActiveWorkbook.ReadOnlyRecommended
    ElseIf IsWord() Then
        GetCurrDocReadonlyRecommended = GetActiveDocument.ReadOnlyRecommended
    Else
        ' Attribute not present in Powerpoint
        GetCurrDocReadonlyRecommended = False
    End If

End Function

Public Sub ChangeCurrDocDir()
    ' Change to the appropriate directory (and drive)
    Dim path As String
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "ChangeCurrDocDir")

    If Not EmbeddedApp() Then
        path = GetCurrDocPath()
        If Len(path) <> 0 Then
            If Mid$(path, 2, 1) = ":" Then
                ChDrive Left(path, 1)
            End If
            ChDir path
        End If
        If GStacker.Tracing Then
            GStacker.TraceMsg "Dir: " & path
        End If
    End If

End Sub

Private Function GetActivePresentation() As Object
    ' Tries to find active presentation which is not always set in PowerPoint
    ' for reasons best known to Microsoft. (Different behaviour to Word or Excel)
    Dim Doc As Object
    Dim i As Integer

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetActivePresentation")

    Set GetActivePresentation = Nothing

    On Error Resume Next
    Set Doc = m_App.ActivePresentation
    If err <> 0 Or Doc Is Nothing Then
        GStacker.Clear
        err.Clear
        On Error GoTo 0
        ' See how many presentations open and assume last one is Active one!
        If m_App.Presentations.Count > 0 Then
            Set Doc = m_App.Presentations(m_App.Presentations.Count)
        End If
    End If

    Set GetActivePresentation = Doc
End Function

Private Function GetActiveWorkbook() As Object
    ' Provide for special use during startup when activeworkbook may not be set
    Dim Doc As Object
    Dim i As Integer

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetActiveWorkbook")

    Set GetActiveWorkbook = Nothing

    On Error Resume Next
    Set Doc = m_App.ActiveWorkbook
    If err <> 0 Or Doc Is Nothing Then
        err.Clear
        GStacker.Clear
        On Error GoTo 0
        ' See how many presentations open and assume last one is Active one!
        If m_App.Workbooks.Count > 0 Then
            Set Doc = m_App.Workbooks(m_App.Workbooks.Count)
        End If
    End If

    Set GetActiveWorkbook = Doc
End Function

Public Function GetActiveDocument() As Object
    ' Provide for special use during startup when activeworkbook may not be set
    Dim Doc As Object
    Dim i As Integer

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetActiveDocument")

    Set GetActiveDocument = Nothing

    On Error Resume Next
    Set Doc = m_App.ActiveDocument
    If err <> 0 Or Doc Is Nothing Then
        err.Clear
        GStacker.Clear
        On Error GoTo 0
        ' See how many Documents open and assume last one is Active one!
        If m_App.Documents.Count > 0 Then
            Set Doc = m_App.Documents(m_App.Documents.Count)
        End If
    End If

    Set GetActiveDocument = Doc
End Function

Public Sub OpenFile(Fname As String, bReadOnly As Boolean)

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "Openfile")

    If UseDelayedEvent() Then
        Dim de As DelayedEvent
        Set de = New DelayedEvent
        de.InitOpen m_App, Me, Fname, bReadOnly
        SaveDelayedEvent de
    Else
        OpenFileImmediate Fname, bReadOnly
    End If
    
End Sub

Public Sub OpenFileImmediate(Fname As String, bReadOnly As Boolean)
    ' Called when DelayedEvent processed

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "OpenFileImmediate")

    If IsExcel() Then
        m_App.Workbooks.Open FileName:=Fname, ReadOnly:=bReadOnly
    ElseIf IsWord() Then
        m_App.Documents.Open FileName:=Fname, ReadOnly:=bReadOnly
    Else
        If bReadOnly Then
            m_App.Presentations.Open FileName:=Fname, ReadOnly:=msoTrue
        Else
            m_App.Presentations.Open FileName:=Fname, ReadOnly:=msoFalse
        End If
    End If

End Sub

Public Sub SaveCurrDoc()

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SaveCurrDoc")
    If IsExcel() Then
        GetActiveWorkbook.Save
    ElseIf IsWord() Then
        GetActiveDocument.Save
    Else
        GetActivePresentation.Save
    End If

End Sub

Public Sub SaveAsCurrDoc(NewFileName As String)

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SaveAsCurrDoc")
    If UseDelayedEvent() Then
        Dim de As New DelayedEvent
        de.InitSaveAs m_App, Me, NewFileName
        SaveDelayedEvent de
    Else
        SaveAsCurrDocImmediate NewFileName
    End If

End Sub

Public Sub SaveAsCurrDocImmediate(NewFileName As String)

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SaveAsCurrDoc")
    If IsExcel() Then
        GetActiveWorkbook.SaveAs NewFileName
    ElseIf IsWord() Then
        GetActiveDocument.SaveAs NewFileName
    Else
        GetActivePresentation.SaveAs NewFileName
    End If

End Sub

Public Sub CloseCurrDoc(SaveChanges As Boolean)

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "CloseCurrDoc")
        
    If UseDelayedEvent() Then
        Dim de As New DelayedEvent
        de.InitClose m_App, Me
        SaveDelayedEvent de
    Else
        CloseCurrDocImmediate SaveChanges
    End If

End Sub

Public Sub CloseCurrDocImmediate(SaveChanges As Boolean)

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "CloseCurrDocImmediate")

    m_FileClosing = True
    If IsExcel() Then
        GetActiveWorkbook.Close SaveChanges
    ElseIf IsWord() Then
        GetActiveDocument.Close SaveChanges
    Else
        GetActivePresentation.Close
    End If

End Sub

Public Function GetDocumentCount() As Integer

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetDocumentCount")

    If IsExcel() Then
        GetDocumentCount = m_App.Workbooks.Count
    ElseIf IsWord() Then
        GetDocumentCount = m_App.Documents.Count
    Else
        GetDocumentCount = m_App.Presentations.Count
    End If

End Function

Public Sub SetCurrDocReadOnlyRecommended(NewValue As Boolean)
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "CurrDocReadOnlyRecommended")

    ' Null statement except for Word
    If IsWord() Then
        GetActiveDocument.ReadOnlyRecommended = NewValue
    End If

End Sub

Public Sub ActivateDoc(Docname As String)

    ' May not be needed

End Sub

Public Sub Rename(ByVal OldName As String, ByVal NewName As String)
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "RenameFile")

    If UseDelayedEvent() Then
        Dim de As New DelayedEvent
        de.InitRename m_App, Me, OldName, NewName
        SaveDelayedEvent de
    Else
        NewName = RenameFile(OldName, NewName)
    End If
    
End Sub


Public Function IsExcel() As Boolean
    IsExcel = False
    If Not m_App Is Nothing Then
        If TypeOf m_App Is excel.Application Then
            IsExcel = True
        End If
    End If
End Function

Public Function IsWord() As Boolean
    IsWord = False
    If Not m_App Is Nothing Then
        If TypeOf m_App Is WORD.Application Then
            IsWord = True
        End If
    End If
End Function

Public Function IsPowerPoint() As Boolean
    IsPowerPoint = False
    If Not m_App Is Nothing Then
        If TypeOf m_App Is PowerPoint.Application Then
            IsPowerPoint = True
        End If
    End If
End Function

Public Sub SaveDelayedEvent(de As DelayedEvent)

    ' Add event to end of the list
    If m_DelayedEventHandler Is Nothing Then
        Set m_DelayedEventHandler = New DelayedEventHandler
    End If
    m_DelayedEventHandler.Add de

End Sub

Public Sub RevertImmediate(Added As Boolean, DocPathname As String)
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "RevertImmediate")

    Const CmdTitle = "P4OFC - Undo Check Out"
    Dim p4cmd As String
    Dim Result As Long
    Dim InfoArr() As String
    Dim ErrorArr() As String
    Dim FileName As String
    Dim Docname As String
    Dim SuccessString As String
    Dim i As Integer


    Docname = StripPath(DocPathname)

    ' If opened for add then just execute the command
    If Not Added Then
        SuccessString = " reverted"
    Else
        SuccessString = " abandoned"
    End If

    p4cmd = p4cmdstring("revert ", DocPathname)

    Result = p4runcmd(p4cmd, InfoArr, ErrorArr, FileName)

    g_p4interface.SaveArrays InfoArr, ErrorArr

    If Result = 0 Then
        ' Check that command was succesful
        If Not IsEmptyArray(InfoArr) Then
            i = LBound(InfoArr)
            If (InStr(1, InfoArr(i), Docname) <> 0) And _
                (InStr(1, InfoArr(i), SuccessString) <> 0) Then

                If Not Added Then
                    ' So now reopen the document!
                    OpenFile DocPathname, False
                End If
            End If
        End If
    Else
        ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr
    End If

Exit_Block:

End Sub

Public Sub SyncFile()

    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SyncFile")

    If UseDelayedEvent() Then
        ' close before reverting so that file is not locked.
        CloseCurrDoc False
        
        Dim de As DelayedEvent
        Set de = New DelayedEvent
        de.InitSync m_App, Me, GetCurrDocPathname
        SaveDelayedEvent de
    Else
        Dim path As String
        path = GetCurrDocPathname
        ' close before reverting so that file is not locked.
        CloseCurrDoc False
        SyncFileImmediate path
    End If
    
End Sub

Public Sub SyncFileImmediate(DocPathname As String)
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "SyncFile")

    Const CmdTitle = "P4OFC - Sync To Latest"
    Dim p4cmd As String
    Dim Result As Long
    Dim InfoArr() As String
    Dim ErrorArr() As String
    Dim FileName As String
    Dim SuccessString As String
    Dim f As Fstat
    Dim i As Integer


    p4cmd = p4cmdstring("sync ", DocPathname)

    Result = p4runcmd(p4cmd, InfoArr, ErrorArr, FileName)

    g_p4interface.SaveArrays InfoArr, ErrorArr

    ' Now check that sync succeeded
    Set f = New Fstat
    f.Initialize Me, DocPath:=DocPathname
    f.Run
    If f.HaveRev <> f.HeadRev Then
        ResultForm.DisplayResult CmdTitle, DocPathname, Result, InfoArr, ErrorArr
    End If

    OpenFile DocPathname, False

End Sub

Public Sub ShellExecute(LocalFileName As String)
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "ShellExecute")
    Dim opened As Boolean
    Dim f As Fstat
    Dim i As Integer
    Dim ext As String
    Dim SameAppType As Boolean
    
    Set f = New Fstat
    f.Initialize Me, DocPath:=LocalFileName
    f.Run
        
    If Not NoCurrDoc() Then
        If f.ClientFile = GetCurrDocPathname Then
            Exit Sub
        End If
    End If
    
    ' Open in current app if of the same file type, otherwise use shell execute
    i = Len(f.ClientFile)
    ext = ""
    Do While i > 0
        If Mid$(f.ClientFile, i, 1) = "." Then
            ext = Mid$(f.ClientFile, i + 1)
            Exit Do
        End If
        i = i - 1
    Loop
    SameAppType = False
    If IsWord() Then
        If Left$(ext, 3) = "doc" Or Left$(ext, 3) = "dot" Then
            SameAppType = True
        End If
    ElseIf IsExcel() Then
        If Left$(ext, 2) = "xl" Then
            SameAppType = True
        End If
    ElseIf IsPowerPoint() Then
        If Left$(ext, 2) = "pp" Or Left$(ext, 3) = "pot" Then
            SameAppType = True
        End If
    End If
    If SameAppType Then
        OpenFile f.ClientFile, bReadOnly:=False
    Else
        If UseDelayedEvent() Then
            Dim de As New DelayedEvent
            de.InitShellExecute m_App, Me, f.ClientFile
            SaveDelayedEvent de
        Else
            ShellExecuteImmediate f.ClientFile
        End If
    End If
End Sub

Public Sub ShellExecuteImmediate(LocalFileName As String)
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "OpenDocumentImmediate")
    Dim opened As Boolean
    Dim dir As String
    Dim ErrMsg As String
    
    dir = GetDir(LocalFileName)
    opened = ShellEx("open", LocalFileName, "", dir, SW_SHOWMAXIMIZED, ErrMsg)
    If Not opened Then
        MsgBox "Failed to launch application: " & ErrMsg, vbOKOnly + vbExclamation, "P4OFC Show Opened Documents"
    End If
End Sub

Public Function IsVersion97() As Boolean
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "IsVersion97")
    Dim ver As String
    
    IsVersion97 = False
    ver = m_App.Version
    If Left$(ver, 3) = "8.0" Then
        IsVersion97 = True
    End If
    
End Function

' function to detect if we are in Office2000 (instead of 97)
Public Function IsVersion2000() As Boolean
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "IsVersion2000")
    Dim ver As String
    
    IsVersion2000 = False
    ver = m_App.Version
    If Left$(ver, 3) = "9.0" Then
        IsVersion2000 = True
    End If
    
End Function

Public Function IsVersionXP() As Boolean
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "IsVersionXP")
    Dim ver As String
    
    IsVersionXP = False
    ver = m_App.Version
    If Left$(ver, 4) = "10.0" Then
        IsVersionXP = True
    End If
    
End Function

Public Function IsVersionXPOrGreater() As Boolean
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "IsVersionXPOrGreater")
    Dim ver As String
    
    IsVersionXPOrGreater = False
    ver = m_App.Version
    If CInt(Left$(ver, 2)) >= 10 Then
        IsVersionXPOrGreater = True
    End If
    
End Function

Public Function IsVersionXPOr2003() As Boolean
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "IsVersionXPOr2003")
    Dim ver As Integer
    
    IsVersionXPOr2003 = False
    ver = CInt(Left$(m_App.Version, 2))
    If ver = 10 Or ver = 11 Then
        IsVersionXPOr2003 = True
    End If
    
End Function

Public Function IsVersion2007OrGreater() As Boolean
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "IsVersion2007OrGreater")
    Dim ver As Integer
    
    IsVersion2007OrGreater = False
    ver = CInt(Left$(m_App.Version, 2))
    If ver >= 12 Then
        IsVersion2007OrGreater = True
    End If
    
End Function

Public Function IsVersion2010OrGreater() As Boolean
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "IsVersion2010OrGreater")
    Dim ver As String
    
    IsVersion2010OrGreater = False
    ver = m_App.Version
    If CInt(Left$(ver, 2)) >= 14 Then
        IsVersion2010OrGreater = True
    End If
    
End Function

Public Function IsVersion2013() As Boolean
    Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "IsVersion2013")
    Dim ver As Integer
    
    IsVersion2013 = False
    ver = CInt(Left$(m_App.Version, 2))
    If ver = 15 Then
        IsVersion2013 = True
    End If
    
End Function

Public Function UseDelayedEvent() As Boolean
    ' Decide when to use delayed events (alternative is to execute immediately)
    
    'UseDelayedEvent = IsPowerPoint() Or (IsExcel() And IsVersion97())
    ' It seemed as if Word2003 preferred the events, but not any more!
    UseDelayedEvent = Not IsWord()
    
End Function