Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "0{00020906-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "ModuleImporter"
Option Explicit
Option Private Module
''
Const vbext_ct_ClassModule = 2
Const vbext_ct_Document = 100
Const vbext_ct_MSForm = 3
Const vbext_ct_StdModule = 1
Const DiffProgramLocation = "\Src\Utilities\VBAUtils\diff.exe"
Const GitProgramLocation = "\Src\Utilities\VBAUtils\git.exe"
Dim bleSkipModuleTracking As Boolean
Dim FSO As Object

Dim tmpExportFolders() As String


Sub testImportModulesFromFolder()
    Dim codeBase As String
    codeBase = Environ("CodebaseDir")
    
#If EXCEL Then
    ReDim tmpExportFolders(4)
    tmpExportFolders(0) = codeBase & "\Src\OfficeAddins\ExcelAddins\XLAS\VBAModules\Excel\"
    tmpExportFolders(1) = codeBase & "\Src\OfficeAddins\Common\VBA\"
    tmpExportFolders(2) = codeBase & "\Src\OfficeAddins\Common\VBA\APIRegistry\"
    tmpExportFolders(3) = codeBase & "\Src\OfficeAddins\Common\VBA\OFCUI\"
    tmpExportFolders(4) = codeBase & "\Src\OfficeAddins\Common\VBA\LM\"
#ElseIf POWERPOINT And LOADER Then
    ReDim tmpExportFolders(3)
    tmpExportFolders(0) = codeBase & "\Src\OfficeAddins\PowerPoint\PowerPoint\Loader"
    tmpExportFolders(1) = codeBase & "\Src\OfficeAddins\Common\VBA\"
    tmpExportFolders(2) = codeBase & "\Src\OfficeAddins\Common\VBA\APIRegistry\"
    tmpExportFolders(3) = codeBase & "\Src\OfficeAddins\Common\VBA\OFCUI\"
#ElseIf POWERPOINT And LEGACY Then
    ReDim tmpExportFolders(5)
    tmpExportFolders(0) = codeBase & "\Src\OfficeAddins\PowerPoint\PowerPoint\"
    tmpExportFolders(1) = codeBase & "\Src\OfficeAddins\PowerPoint\PowerPoint\Legacy"
    tmpExportFolders(2) = codeBase & "\Src\OfficeAddins\Common\VBA\"
    tmpExportFolders(3) = codeBase & "\Src\OfficeAddins\Common\VBA\APIRegistry\"
    tmpExportFolders(4) = codeBase & "\Src\OfficeAddins\Common\VBA\OFCUI\"
    tmpExportFolders(5) = codeBase & "\Src\OfficeAddins\Common\VBA\LM\"
#ElseIf POWERPOINT Then
    ReDim tmpExportFolders(4)
    tmpExportFolders(0) = codeBase & "\Src\OfficeAddins\PowerPoint\PowerPoint\"
    tmpExportFolders(1) = codeBase & "\Src\OfficeAddins\Common\VBA\"
    tmpExportFolders(2) = codeBase & "\Src\OfficeAddins\Common\VBA\APIRegistry\"
    tmpExportFolders(3) = codeBase & "\Src\OfficeAddins\Common\VBA\OFCUI\"
    tmpExportFolders(4) = codeBase & "\Src\OfficeAddins\Common\VBA\LM\"
#ElseIf WORD And LEGACY Then
    ReDim tmpExportFolders(5)
    tmpExportFolders(0) = codeBase & "\Src\OfficeAddins\Word\Word\"
    tmpExportFolders(1) = codeBase & "\Src\OfficeAddins\Word\WordLegacy\"
    tmpExportFolders(2) = codeBase & "\Src\OfficeAddins\Common\VBA\"
    tmpExportFolders(3) = codeBase & "\Src\OfficeAddins\Common\VBA\APIRegistry\"
    tmpExportFolders(4) = codeBase & "\Src\OfficeAddins\Common\VBA\OFCUI\"
    tmpExportFolders(5) = codeBase & "\Src\OfficeAddins\Common\VBA\LM\"
#ElseIf WORD Then
    ReDim tmpExportFolders(4)
    tmpExportFolders(0) = codeBase & "\Src\OfficeAddins\Word\Word\"
    tmpExportFolders(1) = codeBase & "\Src\OfficeAddins\Common\VBA\"
    tmpExportFolders(2) = codeBase & "\Src\OfficeAddins\Common\VBA\APIRegistry\"
    tmpExportFolders(3) = codeBase & "\Src\OfficeAddins\Common\VBA\OFCUI\"
    tmpExportFolders(4) = codeBase & "\Src\OfficeAddins\Common\VBA\LM\"
#End If
    
    Dim idx As Integer
    For idx = LBound(tmpExportFolders) To UBound(tmpExportFolders)
        importModulesFromFolder tmpExportFolders(idx)
    Next idx
    checkModuleChanges "", True, True
    appendExportFoldersFunction tmpExportFolders
End Sub

Sub appendExportFoldersFunction(tmpExportFolders() As String)
    Dim v
    Dim VBProj As Variant
    Dim VBComp As Variant
    Dim CodeMod As Variant
    Dim lineNum As Long
    Const DQUOTE = """"
    Dim idx As Integer
    
    
    For Each VBComp In Application.VBE.ActiveVBProject.VBComponents
        If VBComp.name = "ModuleImporterHash" Then
            Set CodeMod = VBComp.CodeModule
            Exit For
        End If
    Next VBComp
    
    With CodeMod
        lineNum = .CountOfLines + 1
        .InsertLines lineNum, " "
        lineNum = lineNum + 1
        .InsertLines lineNum, "Public Function getExportFolders() As String()"
        lineNum = lineNum + 1
        .InsertLines lineNum, "    Static exportFolders(0 To " & UBound(tmpExportFolders) & ") As String"
        lineNum = lineNum + 1
        .InsertLines lineNum, "    Static assigned As Boolean"
        lineNum = lineNum + 1
        .InsertLines lineNum, "    If Not assigned Then"
        lineNum = lineNum + 1
        .InsertLines lineNum, "        assigned = True"
        lineNum = lineNum + 1
        
        For idx = LBound(tmpExportFolders) To UBound(tmpExportFolders)
            .InsertLines lineNum, "        exportFolders(" & CStr(idx) & ") = " & DQUOTE & tmpExportFolders(idx) & DQUOTE
            lineNum = lineNum + 1
        Next idx
        
        .InsertLines lineNum, "    End If"
        lineNum = lineNum + 1
        .InsertLines lineNum, "    getExportFolders = exportFolders"
        lineNum = lineNum + 1
        .InsertLines lineNum, "End Function"
    End With
End Sub


Public Function getFSO() As Object
    If FSO Is Nothing Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
    End If
    Set getFSO = FSO
End Function

Public Sub importModuleFromFile(modulePath As String)
    If (dir(modulePath, vbNormal) <> "") Then
        Application.VBE.ActiveVBProject.VBComponents.Import modulePath
    End If
End Sub

Public Sub importModulesFromFolder(SourceFolder As String)
    Dim moduleFile As String
    Dim mask As String
    If (dir(SourceFolder, vbDirectory) <> "") Then
        mask = SourceFolder & "\" & "*.cls"
        moduleFile = dir(mask)
        Do While moduleFile <> ""
            If moduleFile = "ThisWorkbook.cls" Then
                ReadModuleCodeFromFile Application.VBE.ActiveVBProject.VBComponents.Item("ThisWorkbook"), SourceFolder & "\" & moduleFile
            ElseIf Mid(moduleFile, 1, 5) = "Sheet" Then
                ''NOTHING FOR NOW!
            Else
                Application.VBE.ActiveVBProject.VBComponents.Import SourceFolder & "\" & moduleFile
            End If
            moduleFile = dir
        Loop
        
        mask = SourceFolder & "\" & "*.bas"
        moduleFile = dir(mask)
        Do While moduleFile <> ""
            If moduleFile = "ModuleImporter.bas" Then
                ''NOTHING FOR NOW!
            Else
                Application.VBE.ActiveVBProject.VBComponents.Import SourceFolder & "\" & moduleFile
            End If
            moduleFile = dir
        Loop
        
        mask = SourceFolder & "\" & "*.frm"
        moduleFile = dir(mask)
        Do While moduleFile <> ""
            Application.VBE.ActiveVBProject.VBComponents.Import SourceFolder & "\" & moduleFile
            moduleFile = dir
        Loop
    End If
End Sub

Sub ForceExportModules()
    Dim codeBase As String
    On Error GoTo handleError
    bleSkipModuleTracking = True
    ExportModules
handleError:
    bleSkipModuleTracking = False
End Sub

Sub WriteModuleCodeToFile(VBComp As Variant, strPath As String)
    Dim oFile As Object
    Dim strLines As String
    
    If VBComp.CodeModule.CountOfLines > 0 Then
        Set oFile = FSO.CreateTextFile(strPath)
            
        strLines = VBComp.CodeModule.Lines(1, VBComp.CodeModule.CountOfLines)
        oFile.WriteLine strLines
        oFile.Close
        Set FSO = Nothing
    End If
End Sub

Sub ReadModuleCodeFromFile(VBComp As Variant, strPath As String)
    Dim oFile As Object
    Dim strLines As String
    Dim deleteLineCount As Integer
    Dim i As Integer
    
    deleteLineCount = 0
    
    VBComp.CodeModule.AddFromFile strPath
    strLines = VBComp.CodeModule.Lines(1, 1)
    If (InStr(strLines, "VERSION 1.0 CLASS") > 0) Then
        For i = 2 To VBComp.CodeModule.CountOfLines + 1
            strLines = VBComp.CodeModule.Lines(i, 1)
            If (InStr(LCase(strLines), LCase("Option Explicit")) > 0) Then
                deleteLineCount = i - 1
                Exit For
            End If
        Next i
    End If
    If deleteLineCount > 0 Then
        VBComp.CodeModule.DeleteLines 1, deleteLineCount
    End If
End Sub

Function overwriteIfChanged(newFile As String, AppSpecificTargetFile As String) As Boolean
    Dim result As Integer
    Dim tempOut As String
    Dim f
    Dim doCopy As Boolean
    doCopy = False
    Dim actionReport As String
    Dim targetFile As String
    
    Dim wsh As Object
    Set wsh = VBA.CreateObject("WScript.Shell")
    Dim waitOnReturn As Boolean: waitOnReturn = True
    Dim windowStyle As Integer: windowStyle = 0
    Dim errorCode As Integer
    
    Dim codeBase As String
    codeBase = Environ("CodebaseDir")
    Dim exportFolders() As String
    
    overwriteIfChanged = False
    
    exportFolders = Application.Run("getExportFolders")
    
    '''''Check in which folder the file is residing currently'''
    Dim idx As Integer
    For idx = LBound(exportFolders) To UBound(exportFolders)
        If getFSO().FileExists(codeBase & "\" & exportFolders()(idx) & AppSpecificTargetFile) Then
            targetFile = codeBase & "\" & exportFolders()(idx) & "\" & AppSpecificTargetFile
            Exit For
        End If
    Next idx
    
    If targetFile = "" Then
        targetFile = codeBase & "\" & exportFolders()(0) & "\" & AppSpecificTargetFile
    End If
    
    errorCode = wsh.Run(Chr(34) & Environ("CodebaseDir") & DiffProgramLocation & Chr(34) & " -i " & newFile & " " & targetFile, windowStyle, waitOnReturn)
    If errorCode = 0 Then
        doCopy = False
    Else
        doCopy = True
    End If
    
    If doCopy And getFSO().FileExists(newFile) Then
        If getFSO().FileExists(targetFile) Then
            getFSO().DeleteFile (targetFile)
        End If
        getFSO().CopyFile newFile, targetFile
        actionReport = "CHANGED "
    Else
        actionReport = "KEPT    "
    End If
        
    If InStr(targetFile, ".bak") > 0 Then
        targetFile = newFile
    End If
    
    Debug.Print actionReport & " [" & targetFile & "]"
    
    Set wsh = Nothing
    overwriteIfChanged = doCopy
End Function


Sub ExportModules()
    Dim VBComp As Variant
    Dim tempFile As String
    Dim lineCharCount As Integer
    Dim tmpSavePath As String
    
    tmpSavePath = Environ$("TEMP")
    
    lineCharCount = 0
    If dir(tmpSavePath, vbDirectory) <> "" Then
        tempFile = tmpSavePath & "\" & "TempFile"
        For Each VBComp In Application.VBE.ActiveVBProject.VBComponents
            If checkModuleChanges(VBComp.name, True) Or (VBComp.Type = vbext_ct_MSForm And VBComp.HasOpenDesigner) Then
                If lineCharCount > 0 Then
                    lineCharCount = 0
                    Debug.Print
                End If
                Select Case VBComp.Type
                    Case vbext_ct_StdModule
                        VBComp.Export tempFile
                        overwriteIfChanged tempFile, VBComp.name & ".bas"
                    Case vbext_ct_Document
                        #If EXCEL Then
                        WriteModuleCodeToFile VBComp, tempFile
                        overwriteIfChanged tempFile, VBComp.name & ".cls"
                        #End If
                    Case vbext_ct_ClassModule
                        ' ThisDocument and class modules
                        VBComp.Export tempFile
                        overwriteIfChanged tempFile, VBComp.name & ".cls"
                    Case vbext_ct_MSForm
                        '''' For Forms we have to export to the correct file, otherwise the wrong info about temp
                        '''' file will be stuck in the file causing problems!
                        VBComp.Export tmpSavePath & "\" & VBComp.name & ".frm"
                        overwriteIfChanged tmpSavePath & "\" & VBComp.name & ".frm", VBComp.name & ".frm"
                        overwriteIfChanged tmpSavePath & "\" & VBComp.name & ".frx", VBComp.name & ".frx"
                        Kill tmpSavePath & "\" & VBComp.name & ".frm"
                        Kill tmpSavePath & "\" & VBComp.name & ".frx"
                    Case Else
                        VBComp.Export tempFile
                        overwriteIfChanged tempFile, tmpSavePath & "\" & VBComp.name
                End Select
            Else
                Debug.Print ".";
                lineCharCount = lineCharCount + 1
                If (lineCharCount >= 100) Then
                    Debug.Print
                    lineCharCount = 0
                End If
            End If
        Next
        If dir(tempFile) <> "" Then
            Kill tempFile
        End If
    End If
    If (lineCharCount > 0) Then Debug.Print
    Debug.Print "Export done."
End Sub

Sub deleteAllModules()
    Dim VBComp As Variant
    Dim cnt As Integer
    For Each VBComp In Application.VBE.ActiveVBProject.VBComponents
        If VBComp.name <> "ModuleImporter" And VBComp.name <> "ThisWorkbook" And VBComp.Type <> vbext_ct_Document Then
            Application.VBE.ActiveVBProject.VBComponents.Remove VBComp
        ElseIf VBComp.Type = vbext_ct_Document Then
            cnt = VBComp.CodeModule.CountOfLines
            If cnt > 0 Then
                VBComp.CodeModule.DeleteLines 1, VBComp.CodeModule.CountOfLines
            End If
        End If
    Next
End Sub


Function computeCRC16(txt As String) As String
Dim x As Long
Dim mask, i, j, nC, Crc As Integer
Dim c As String

Crc = &HFFFF

For nC = 1 To Len(txt) Step 2
    j = val("&H" + LCase$(Mid(txt, nC, 2)))
    Crc = Crc Xor j
    For j = 1 To 8
        mask = 0
        If Crc / 2 <> Int(Crc / 2) Then mask = &HA001
        Crc = Int(Crc / 2) And &H7FFF: Crc = Crc Xor mask
    Next j
Next nC

computeCRC16 = Hex$(Crc) ''

End Function


Public Function checkModuleChanges(Optional moduleName As String = "", Optional Reset As Boolean = False, Optional Serialize As Boolean = False, Optional PassedEnvCodeBaseDir As String = "") As Boolean
    Dim VBComp As Variant
    Dim strContent As String
    Dim strHash As String
    Dim strHashNew As String
    Dim allComponents As Variant
    Static moduleChanges As Object
    Dim lineCharCount As Integer
    lineCharCount = 0
    
    checkModuleChanges = False
    
    ''''Never save for ModuleImporterHash:   False means no changes'''
    If moduleName = "ModuleImporterHash" Then
        Exit Function
    End If
    
    ''''Always save when the SkipModuleTracking is set: True means Yes, there were changes! '''
    If bleSkipModuleTracking Then
        checkModuleChanges = True
        Exit Function
    End If
    
    
    If moduleChanges Is Nothing Then
        Set moduleChanges = CreateObject("Scripting.Dictionary")
        On Error Resume Next
        Application.Run "PopulateHashDictionary", moduleChanges
        On Error GoTo 0
    End If
    
    If moduleName = "" Then
        Set allComponents = Application.VBE.ActiveVBProject.VBComponents
    Else
        Set allComponents = New Collection
        allComponents.Add Application.VBE.ActiveVBProject.VBComponents.Item(moduleName)
    End If
    
    For Each VBComp In allComponents
        Dim numLines As Integer
        numLines = VBComp.CodeModule.CountOfLines
        If numLines = 0 Then
            numLines = 1
        End If
        strContent = VBComp.name & vbNewLine & "--" & vbNewLine & VBComp.CodeModule.Lines(1, numLines)
        strHashNew = computeCRC16(strContent) '''Application.Run("hashStr", strContent)
        If (moduleChanges.Exists(VBComp.name)) Then
            strHash = moduleChanges.Item(VBComp.name)
        Else
            strHash = vbNullString
        End If
        If moduleName = "" Then
            If strHashNew <> strHash Then
                Debug.Print "+";
            Else
                Debug.Print ".";
            End If
            lineCharCount = lineCharCount + 1
            If (lineCharCount >= 100) Then
                Debug.Print
                lineCharCount = 0
            End If
        End If
        If strHashNew <> strHash Then
            checkModuleChanges = True
            If (moduleChanges.Exists(VBComp.name)) Then
                If Reset Then
                    moduleChanges.Item(VBComp.name) = strHashNew
                End If
            Else
                moduleChanges.Add VBComp.name, strHashNew
            End If
        End If
    Next VBComp
    
    
    If Serialize Then
        Dim v
        Dim VBProj As Variant
        Dim CodeMod As Variant
        Dim lineNum As Long
        Const DQUOTE = """"
        
        For Each VBComp In Application.VBE.ActiveVBProject.VBComponents
            If VBComp.name = "ModuleImporterHash" Then
                Application.VBE.ActiveVBProject.VBComponents.Remove VBComp
                Exit For
            End If
        Next VBComp
        
        Set VBProj = Application.VBE.ActiveVBProject
        Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
        VBComp.name = "ModuleImporterHash"
        Set CodeMod = VBComp.CodeModule
        
        '''''''''''''''''''''''' GET THE GIT HASH '''''''''''''''''''''''''
        On Error Resume Next
        Dim GitHash As String
        Dim HASHfile As String
        
        Dim f, contents, var1
        Set f = getFSO().OpenTextFile(PassedEnvCodeBaseDir & "\.git\HEAD", 1)
        contents = f.ReadAll
        f.Close
        f = Null
        
        HASHfile = Replace$(Mid$(contents, 6), "/", "\")
        HASHfile = Left$(HASHfile, Len(HASHfile) - 1)
        HASHfile = PassedEnvCodeBaseDir & "\.git\" & HASHfile & ""
        Set f = getFSO().OpenTextFile(HASHfile)
        GitHash = Left$(f.ReadAll, 10)
        f.Close
        On Error GoTo 0
        '''''''''''''''''''''''' GOT THE GIT HASH ''''''''''''''''''''''''''
        
        With CodeMod
            lineNum = .CountOfLines + 1
            
            .InsertLines lineNum, "Public Const LatestGitHash = " & DQUOTE & GitHash & DQUOTE
            lineNum = lineNum + 1
            .InsertLines lineNum, "Public Const BuildDateTime = " & DQUOTE & Now & DQUOTE
            lineNum = lineNum + 1
            .InsertLines lineNum, ""
            lineNum = lineNum + 1
                                    
            .InsertLines lineNum, "Public Sub PopulateHashDictionary(byref d as Object)"
            For Each v In moduleChanges.Keys
                lineNum = lineNum + 1
                .InsertLines lineNum, "    d.add " & DQUOTE & v & DQUOTE & "," & DQUOTE & moduleChanges.Item(v) & DQUOTE
            Next v
            lineNum = lineNum + 1
            .InsertLines lineNum, "End Sub"
        End With
    End If
    
    
    If moduleName = "" Then
        If lineCharCount > 0 Then Debug.Print
        Debug.Print "Done (Re)hashing."
    End If
End Function




Attribute VB_Name = "AboutBox"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit

Private m_proxy As ToolProxy
''''
Private Sub Class_Initialize()
  pushTrace "Class_Initialize", "AboutBox.cls"
    If m_proxy Is Nothing Then
        Set m_proxy = New ToolProxy
        m_proxy.VBAWorkbookName = "BloombergUIWord"
        m_proxy.toolName = "AboutBox"
        m_proxy.AssemblyName = "AboutBox"
        m_proxy.ManagedTypeName = "Bloomberg.OfficeTools.AboutBox.AboutBox"
    End If
    popTrace "Class_Initialize"
End Sub

Private Sub Class_Terminate()
    pushTrace "Class_Terminate", "AboutBox.cls"
    Set m_proxy = Nothing
    popTrace "Class_Terminate"
End Sub

Public Sub ITool_Activate(Parameters() As Variant)
    pushTrace "ITool_Activate", "AboutBox.cls"
    If m_proxy Is Nothing Then
        popTrace "ITool_Activate"
        Exit Sub
    End If
    
    ReDim Parameters(1)
    Parameters(0) = ""
    Parameters(1) = "v3"
    m_proxy.ITool_Activate Parameters
    popTrace "ITool_Activate"
End Sub

Public Function ITool_OnDeactivated() As String()
    pushTrace "ITool_OnDeactivated", "AboutBox.cls"
    Dim Parameters(0) As String
    
    If m_proxy Is Nothing Then
        popTrace "ITool_OnDeactivated"
        Exit Function
    End If
    
    m_proxy.ITool_OnDeactivated
    
    Parameters(0) = ""
    ITool_OnDeactivated = Parameters
    popTrace "ITool_OnDeactivated"
End Function



Attribute VB_Name = "AddinLoader"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit

Public Sub Load(xpath As String)
  pushTrace "Load", "AddinLoader.cls", xpath
    
    Dim doc As DOMDocument
    Set doc = GetCustomUIDom()
    
    If IsPowerToolsAvailable = False Then
       popTrace "Load"
       Exit Sub
    End If
    
    'MsgBox "AddinLoader->Load called. XML config filename is: " + fileName
    
    Dim addinNodes As IXMLDOMNodeList
    Dim addinsRoot As IXMLDOMNode
    Set addinsRoot = doc.SelectSingleNode("//Addins")
    If addinsRoot Is Nothing Then
        popTrace "Load"
        Exit Sub
    End If
    
    Dim basePath As String
    basePath = GetAttributeText(addinsRoot, "basePath")
    If Right(basePath, 1) <> "\" Then
        basePath = basePath & "\"
    End If
    
    Set addinNodes = doc.SelectNodes(xpath)
    
    Dim addinNode As IXMLDOMNode
    For Each addinNode In addinNodes
        Dim isRibbonAddin As Boolean
        Dim addinName As String
        Dim minimalApplicableExcelVersion As String
        
        addinName = GetAttributeText(addinNode, "name")
        minimalApplicableExcelVersion = GetAttributeText(addinNode, "minimalApplicableExcelVersion")
        'MsgBox "Addin name is: " + addinName + " minimalApplicableExcelVersion is: " + minimalApplicableExcelVersion
        
        Dim LoadAddIn As Boolean
        LoadAddIn = True
        
        Dim isTsUser As Long
        isTsUser = 0
        
        If minimalApplicableExcelVersion = "" Or (val(Application.Version) >= val(minimalApplicableExcelVersion)) Then
        
            isRibbonAddin = InStr(LCase(addinName), "ribbon") > 0
            
            If LoadLocally(addinName) = False Then
                If LoadFromRegistrySetting(addinName) = False Then
                    If LoadFromConfigFileSetting(basePath, addinName) = False Then
                        LoadAddIn = False
                    End If
                End If
            End If
            
            If LoadAddIn = True Then
                If isRibbonAddin Then
                    gRibbonAddinName = addinName
                End If
                
                On Error GoTo 0
            End If
        End If
        
    Next addinNode
    
    popTrace "Load"
End Sub


Public Function LoadLocally(addinName As String) As Boolean
    pushTrace "LoadLocally", "AddinLoader.cls", addinName
    LoadLocally = True
    Dim addinPath As String
    
    addinPath = ThisDocument.path & "\" & addinName
    
    On Error GoTo failure
    Application.AddIns.Add addinPath
    
    popTrace "LoadLocally"
    Exit Function
    
failure:
    LoadLocally = False
    popTrace "LoadLocally"
End Function

Public Function LoadFromConfigFileSetting(basePath As String, addinName As String) As Boolean
    pushTrace "LoadFromConfigFileSetting", "AddinLoader.cls", basePath, addinName
    LoadFromConfigFileSetting = True
    Dim addinPath As String
    addinPath = basePath & addinName
    
    On Error GoTo failure
    Application.AddIns.Add(addinPath).Installed = msoTrue
    popTrace "LoadFromConfigFileSetting"
    Exit Function
    
failure:
    LoadFromConfigFileSetting = False
    popTrace "LoadFromConfigFileSetting"
End Function

Public Function LoadFromRegistrySetting(addinName As String) As Boolean
    pushTrace "LoadFromRegistrySetting", "AddinLoader.cls", addinName
    
    Dim addinPath As String
        
    On Error GoTo failure
    
    If GetOfficeToolsPath(addinPath) = True Then
        addinPath = uQualifyPath(addinPath) & addinName
        Application.AddIns.Add(addinPath).Installed = msoTrue
        LoadFromRegistrySetting = True
    End If
    popTrace "LoadFromRegistrySetting"
    Exit Function
    
failure:
    LoadFromRegistrySetting = False
    popTrace "LoadFromRegistrySetting"
End Function



Attribute VB_Name = "BBPTv2_clsAppEvents"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit
'2011-09-09.1

Public WithEvents WordApp As Application
Attribute WordApp.VB_VarHelpID = -1


Dim PreviousDocumentCount As Integer

Private Sub Class_Initialize()
  pushTrace "Class_Initialize", "BBPTv2_clsAppEvents.cls"
    
    Set WordApp = Application
    
    If wrdHasActiveDocument = True Then
        PreviousDocumentCount = Application.Documents.count
    End If
    popTrace "Class_Initialize"
End Sub

Private Sub Class_Terminate()
    pushTrace "Class_Terminate", "BBPTv2_clsAppEvents.cls"
    Set WordApp = Nothing
    popTrace "Class_Terminate"
End Sub
Private Sub WordApp_DocumentBeforeClose(ByVal doc As Document, Cancel As Boolean)
    pushTrace "WordApp_DocumentBeforeClose", "BBPTv2_clsAppEvents.cls", doc, Cancel
    If val(Application.Version) = 11 Then
        Dim OldContext As Object
        Set OldContext = Application.CustomizationContext
        Application.CustomizationContext = ThisDocument
        UpdateToolBarPosToRegistry
        ThisDocument.Saved = True
    End If
    popTrace "WordApp_DocumentBeforeClose"
End Sub

Private Sub WordApp_DocumentBeforeSave(ByVal doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
    pushTrace "WordApp_DocumentBeforeSave", "BBPTv2_clsAppEvents.cls", doc, SaveAsUI, Cancel
    Dim pshp            As WORD.InlineShape
    Dim rngBbg          As String
    Dim wkbFileName     As String
    Dim wkbMdb          As String
    Dim sXML            As String
    Dim xmlDoc          As New DOMDocument
    Dim xmlRoot         As IXMLDOMElement
    
    Dim boolXlUnsaved   As Boolean
    
    On Error Resume Next
    boolXlUnsaved = False
    For Each pshp In doc.InlineShapes
        If IsBbgInlineShape(pshp) Then
            wkbFileName = BBPTv2_pptGetShapeTagValue(pshp, "WorkbookFileName")
            rngBbg = BBPTv2_pptGetShapeTagValue(pshp, "RangeName")
            If UCase$(wkbFileName) Like "BOOK*" Then
                wkbMdb = BBPTv2_GetFirstLinkedFile(rngBbg)
                If wkbMdb <> "" Then
                    If UCase$(wkbMdb) Like "BOOK*" Then
                        boolXlUnsaved = True
                        Else
                        'Update the doc variables
                        sXML = BBPTv2_GetDocVariableValueTiedToInlineShape(pshp)
                        If xmlDoc.LoadXML(sXML) = True Then
                            If Not xmlDoc Is Nothing Then
                                Set xmlRoot = xmlDoc.DocumentElement
                                xmlSetAttribute xmlRoot, "WorkbookFileName", wkbMdb
                                BBPTv2_AddDocVariableForInlineShape pshp, xmlDoc.xml
                            End If
                        End If
                    End If
                End If
            End If
        End If
    Next pshp
    If boolXlUnsaved Then
        MsgBox "Some of the shapes in this document is linked to unsaved excel workbooks"
    End If
    
    Set xmlDoc = Nothing
    Set xmlRoot = Nothing
    popTrace "WordApp_DocumentBeforeSave"
End Sub

Private Sub WordApp_DocumentOpen(ByVal doc As Document)
    pushTrace "WordApp_DocumentOpen", "BBPTv2_clsAppEvents.cls", doc
    BBPTv2_CleanupDocVariables doc
    popTrace "WordApp_DocumentOpen"
End Sub

'Private Sub WordApp_AfterPresentationOpen(ByVal Pres As Presentation)
'    'UpdateMenuCheckmarks
'End Sub
'
'Private Sub WordApp_SlideSelectionChanged(ByVal SldRange As SlideRange)
'    If Application.ActiveDocument.Slides.Count <> PreviousSlideCount Then
'        PreviousSlideCount = Application.ActiveDocument.Slides.Count
'        If BBPT_modTocDivider.HasDividerSlides Then
'            UpdateDividers
'        End If
'    End If
'End Sub
'
'Private Sub WordApp_SlideShowBegin(ByVal Wn As SlideShowWindow)
'    Cache_LinkText_Delimiters
'End Sub
'
'Private Sub WordApp_SlideShowEnd(ByVal Pres As Presentation)
'    Restore_LinkText_Delimiters
'End Sub




Attribute VB_Name = "BBPTv2_clsExcelLinkApp"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit

'version:
'   2011-06-22.1
'purpose:
'   Handle Excel automation instance
'changelog:
'   2011-04-15  DI  created

'NB: to allow For-Each method, this class cannot be moved/copied between files,
'but must be exported, then reimported once the following
'(hidden, VB-specific) lines of code are inserted in a text editor:
'In Item:       Attribute Item.VB_UserMemId = 0         '(on first line)
'In NewEnum:    Attribute NewEnum.VB_UserMemID = -4     '(on first line)


Private mParentHandler              As BBPTv2_clsExcelLinkHandler
Private mxlApp                      As Object           'Excel.Application
Private mcolWbks                    As VBA.Collection   'Opened workbooks and their states
Private mOrigSecAutomation          As MsoAutomationSecurity
Private mbleOrigDisplayAlerts       As Boolean
'Private mRTDThrottleInterval        As Integer
Private mCalculation                As Long
Private mCalcWbk                    As Object
Private mbleAppStateIsCached        As Boolean
'

'---------------------
'properties
'---------------------
Public Property Get ParentHandler() As BBPTv2_clsExcelLinkHandler
  pushTrace "ParentHandler", "BBPTv2_clsExcelLinkApp.cls"
    Set ParentHandler = mParentHandler
    popTrace "ParentHandler"
End Property
Public Property Set ParentHandler(pParentHandler As BBPTv2_clsExcelLinkHandler)
    pushTrace "ParentHandler", "BBPTv2_clsExcelLinkApp.cls", pParentHandler
    Set mParentHandler = pParentHandler
    popTrace "ParentHandler"
End Property

Public Property Get Visible() As Boolean
    pushTrace "Visible", "BBPTv2_clsExcelLinkApp.cls"
    If Not (mParentHandler Is Nothing) Then
        Visible = mParentHandler.Visible
    ElseIf Not (mxlApp Is Nothing) Then
        Visible = mxlApp.Visible
    End If
    popTrace "Visible"
End Property

Public Property Get xlApp() As Object
    pushTrace "xlApp", "BBPTv2_clsExcelLinkApp.cls"
    Set xlApp = mxlApp
    popTrace "xlApp"
End Property
Friend Property Set xlApp(pXLApp As Object)
    pushTrace "xlApp", "BBPTv2_clsExcelLinkApp.cls", pXLApp
    'set once
    If mxlApp Is Nothing Then
        Set mxlApp = pXLApp
        CacheAndFreeze_AppState
    End If
    popTrace "xlApp"
End Property

Public Property Get hwnd() As Long
    pushTrace "Hwnd", "BBPTv2_clsExcelLinkApp.cls"
On Error Resume Next
    If Not mxlApp Is Nothing Then
        hwnd = mxlApp.hwnd
        If Err.Number <> 0 Then
            If Err.Number = 462 Then
                'something happened to the window
                'todo: reset xlapp
            End If
            Err.Clear
        End If
    End If
    popTrace "Hwnd"
End Property

Public Property Get Wbks() As VBA.Collection
    pushTrace "Wbks", "BBPTv2_clsExcelLinkApp.cls"
    Set Wbks = mcolWbks
    popTrace "Wbks"
End Property

Public Property Get OriginalSecurityAutomation() As MsoAutomationSecurity
    pushTrace "OriginalSecurityAutomation", "BBPTv2_clsExcelLinkApp.cls"
    OriginalSecurityAutomation = mOrigSecAutomation
    popTrace "OriginalSecurityAutomation"
End Property

'Public Property Let OriginalSecurityAutomation(securityAutomation As MsoAutomationSecurity)
'    mOrigSecAutomation = securityAutomation
'End Property

'Public Property Get OriginalRTDThrottleInterval() As Integer
'    OriginalRTDThrottleInterval = mRTDThrottleInterval
'End Property

'Public Property Let OriginalRTDThrottleInterval(rtdInterval As Integer)
'    mRTDThrottleInterval = rtdInterval
'End Property

Public Property Get OriginalDisplayAlerts() As Boolean
    pushTrace "OriginalDisplayAlerts", "BBPTv2_clsExcelLinkApp.cls"
    OriginalDisplayAlerts = mbleOrigDisplayAlerts
    popTrace "OriginalDisplayAlerts"
End Property

Public Property Get WindowVisible() As Boolean
    pushTrace "WindowVisible", "BBPTv2_clsExcelLinkApp.cls"
    If Not (mxlApp Is Nothing) Then
        WindowVisible = uIsWindowVisible(mxlApp.hwnd)
    End If
    popTrace "WindowVisible"
End Property

Public Property Get HandlerOpened() As Boolean
    pushTrace "HandlerOpened", "BBPTv2_clsExcelLinkApp.cls"
    If Me.Visible = False Then
        HandlerOpened = Not Me.WindowVisible
    End If
    popTrace "HandlerOpened"
End Property

'---------------------
'methods
'---------------------
Private Sub CacheAndFreeze_AppState()
    pushTrace "CacheAndFreeze_AppState", "BBPTv2_clsExcelLinkApp.cls"

    'Save current security state of excel instance and set automation security level to low
    mOrigSecAutomation = mxlApp.AutomationSecurity
    mxlApp.AutomationSecurity = msoAutomationSecurityLow
    
    If Me.Visible = False Then
…