Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 1083e38dd6fcb4b1…

MALICIOUS

Office (OLE)

11.52 MB Created: 2009-04-06 16:56:01 Authoring application: Microsoft Excel First seen: 2015-08-19
MD5: 9b490509ee03b302b3133b91766eca84 SHA-1: 51788cea1123528074761f9eb0045619374b8770 SHA-256: 1083e38dd6fcb4b18c26e7c7a99a369d9d0c2303d46b72c786a009b68be33f64
854 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File Execution: Malicious Script T1059 Command and Scripting Interpreter T1105 Ingress Tool Transfer

The sample is a malicious Excel file containing heavily obfuscated VBA macros. Critical heuristics indicate the use of WScript.Shell, CreateObject, GetObject, and a VBA property-stored shellcode loader, suggesting the macro is designed to download and execute a second-stage payload. The Workbook_Open and Auto_Open macros are present, indicating an auto-execution mechanism. The presence of 'WScript.Shell usage' and 'Potential Shell call in VBA' strongly suggests command execution capabilities.

Heuristics 22

  • VBA macros detected medium 15 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
            shell "Notepad.exe " & BBPTLogPath, 1
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
        Set wsh = VBA.CreateObject("WScript.Shell")
  • LOLBin reference in VBA critical OLE_VBA_LOLBIN
    LOLBin reference in VBA
    Matched line in script
    'NPExcel add-in may have been regasm'd in an older BXLA package (when it was running .net2/.net35).
  • VBA property-stored shellcode loader critical OLE_VBA_PROPERTY_SHELLCODE_LOADER
    VBA auto-exec macro takes the address (VarPtr) of a byte buffer decoded from a document property, marks memory executable (VirtualProtect/VirtualAlloc), and transfers control through a callback API (e.g. SetTimer/EnumWindows). The payload is hidden in the document properties rather than the macro source — the SVCReady loader pattern, a native shellcode runner rather than a parser CVE.
    Matched line in script
        TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
  • VBA ActiveX event launches decoded Excel4 macro critical OLE_VBA_ACTIVEX_XLM_STAGER
    VBA code attached to an auto-firing ActiveX/UserForm control event (e.g. _Layout/_Change/_Painted) decodes a string with Replace/Split/Join/StrReverse/Chr and passes the recovered formula text to ExecuteExcel4Macro. This bridges VBA event activation into XLM formula execution to call Win32 APIs / drop payloads while evading AutoOpen and Shell keyword detection — a high-confidence macro stager, not a specific Office parser CVE.
    Matched line in script
    ' Line #1843:
'  FuncDefn (Sub ExecuteExcel4Macro())
' Line #1844:
  • VBA UserForm hidden-property command stager critical OLE_VBA_USERFORM_HIDDEN_COMMAND_STAGER
    VBA auto-exec macro creates a COM object from a decoded variable and reconstructs command text through Split/Join and hidden UserForm properties such as ControlTipText, Tag, Pages, or HelpContextId. This is a high-confidence macro downloader/loader shape seen in the reviewed OLE set, but it is not an Office CVE exploit primitive.
    Matched line in script
        fields = Split(colHeaderNames, ",")
  • Obfuscated auto-exec VBA loader critical OLE_VBA_OBFUSCATED_AUTOEXEC_LOADER
    Auto-exec VBA reconstructs strings with a heavy custom decoder (numeric char-array, repeated hex-string decode, or junk-token Replace removal) and feeds them to a COM-instantiation or execution sink. This obfuscated-loader shape keeps CreateObject/Shell/URL indicators out of the macro source.
    Matched line in script
            Set FSO = CreateObject("Scripting.FileSystemObject")
  • VBA macro-virus self-replication / AV tampering critical OLE_VBA_MACRO_VIRUS_REPLICATION
    VBA macro programmatically rewrites VBA project code through the VBE object model (CodeModule/VBComponents InsertLines/DeleteLines/AddFromString or OrganizerCopy) to copy itself into the global template and other open documents, and/or disables Office macro-virus protection (Options.VirusProtection = False). This is the defining behavior of the W97M document macro-virus family — self-replicating code with no benign document use, independent of any AV signature.
    Matched line in script
            .InsertLines lineNum, " "
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
            Set FSO = CreateObject("Scripting.FileSystemObject")
  • GetObject call high OLE_VBA_GETOBJ
    GetObject call
    Matched line in script
        Set ppApp = GetObject(, "Powerpoint.Application")
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Public Sub Workbook_Open()
  • Auto_Open macro low OLE_VBA_AUTO
    Auto_Open macro
    Matched line in script
    'In Auto_Open of BlpMain.xla, the only instance of this class will be
  • Auto_Close macro low OLE_VBA_AUTOCLOSE
    Auto_Close macro
    Matched line in script
        'We should not do anything in Auto_Close because it is ran before the
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
        codeBase = Environ("CodebaseDir")
  • Reference to ShellExecute API high SC_STR_SHELLEXEC
    Reference to ShellExecute API
  • Reference to Windows Script Host high SC_STR_WSCRIPT
    Reference to Windows Script Host
  • Reference to LoadLibrary API high SC_STR_LOADLIBRARY
    Reference to LoadLibrary API
  • Reference to GetProcAddress API high SC_STR_GETPROCADDRESS
    Reference to GetProcAddress API
  • Suspicious extracted artifact high EXTRACTED_FILE_STATIC_TRIAGE
    One or more files extracted from inside this sample matched static suspicious-content checks such as script obfuscation, encoded payload blobs, packed data, or execution/download terms.
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://127.0.0.1 In document text (OLE body)
    • http://172.17.2.46/apiservices/ard/ardservice.asmxIn document text (OLE body)
    • http://10.16.98.204:8291/_layouts/GAPI/filelisting.aspx?library=Templates2&folder=In document text (OLE body)
    • http://sf.symcd.com0&In document text (OLE body)
    • http://ocsp.verisign.com0In document text (OLE body)
    • http://schemas.microsoft.com/office/2006/01/customuiIn document text (OLE body)
    • http://support.microsoft.com/default.aspx?scid=kb;EN-US;q176790In document text (OLE body)
    • http://support.microsoft.com/kb/186047/en-usIn document text (OLE body)
    • http://support.microsoft.com/kb/213181In document text (OLE body)
    • http://logo.verisign.com/vslogo.gif0In document text (OLE body)
    • https://www.verisign.com/rpaIn document text (OLE body)
    • https://d.symcb.com/cps0%In document text (OLE body)
    • https://d.symcb.com/rpa0In document text (OLE body)
    • http://sf.symcb.com/sf.crl0WIn document text (OLE body)
    • http://sf.symcb.com/sf.crt0In document text (OLE body)
    • https://www.verisign.com/cps0*In document text (OLE body)
    • https://www.verisign.com/rpa0In document text (OLE body)
    • http://logo.verisign.com/vslogo.gif04In document text (OLE body)
    • http://crl.verisign.com/pca3-g5.crl04In document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 8388608 bytes
SHA-256: 34f38f0dd7a547e45f723f4fdab5fb43384693b171f57b682d02657d3241a6f3
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact contains 1 eval/decoder/string-building token(s).
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-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
Option Explicit

Dim appHandler As ApplicationEvents
Dim BBPTv2_appHandler As BBPTv2_ApplicationEvents

Dim g_prfl_handle As Long

#If VBA7 Then
Dim hAddinMutex As LongPtr
#Else
Dim hAddinMutex As Long
#End If

Private Sub Workbook_AddinInstall()
  pushTrace "Workbook_AddinInstall", "ThisWorkbook.cls"
    'DRQS 35536800 - introduce mutex IPC to avoid automation from ribbon
    'to check if add-in is loaded or not
    g_prof.handle = Prof_BeginSPS("AddinLoading_A", "AddinInstall_E")  'Profiling time since process(Excel) started till this call
    
    If 0 <> hAddinMutex Then
        CloseHandle hAddinMutex
    End If
    hAddinMutex = CreateMutex(0, 1, "bbshared" & CStr(GetCurrentProcessId()))
    
    InstallCOMAddin True
    popTrace "Workbook_AddinInstall"
End Sub

Private Sub Workbook_AddinUninstall()
    pushTrace "Workbook_AddinUninstall", "ThisWorkbook.cls"
    Dim oPopup As Object
DeleteGlobals

On Error GoTo FunctionEnd   'DRQS 9796347
    ' DRQS 9564315
    Set oPopup = Application.CommandBars("Worksheet Menu Bar").Controls("&View")
    oPopup.CommandBar.Controls("&Bloomberg Menu").Delete
FunctionEnd:

On Error GoTo FunctionEnd1
    If val(Application.Version) > 11 And gRibbonAddinName <> "" Then
        Workbooks(gRibbonAddinName).Close
    Else
        InstallCOMAddin False
    End If
       
FunctionEnd1:

    popTrace "Workbook_AddinUninstall"
End Sub

Private Sub InstallCOMAddin(Connect As Boolean)
    pushTrace "InstallCOMAddin", "ThisWorkbook.cls", Connect
    Dim i As Long
    For i = 1 To Application.COMAddIns.count
        If Application.COMAddIns(i).progId = "Bloomberg.CCYReader" Then
            Application.COMAddIns(i).Connect = Connect
        End If
    Next
    popTrace "InstallCOMAddin"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    pushTrace "Workbook_BeforeClose", "ThisWorkbook.cls", Cancel
On Error Resume Next
    If g_MainInitialized Then
        Save_ToolbarPositions
        ' V3Status_OnClose
        Refresh_OnClose
        MAIN_Shutdown
        HitCount
    End If
    ResetEvents
    BLPMain_ResetEvents
'    If (Not appHandler Is Nothing) Then
'        Set appHandler = Nothing
'    End If
'    If (Not BBPTv2_appHandler Is Nothing) Then
'        Set BBPTv2_appHandler = Nothing
'    End If
   'Show_CellFormatState
   popTrace "Workbook_BeforeClose"
End Sub

Public Sub Workbook_Open()
   pushTrace "Workbook_Open", "ThisWorkbook.cls"
    Dim oPopup As Object
    Dim originalUpdating As Boolean
    
    If (g_prof.handle = 0) Then
        g_prof.handle = Prof_BeginSPS("ExcelLoading_A", "EL_BUI_WbOpen_E")  'Profiling time since process(Excel) started till this call, ExcelLoading_A activity
    Else
        g_prof.Res = Prof_Mark(g_prof.handle, "EL_BUI_WbOpen_E") 'AddinLoading_A activity
    End If
    Application.OnTime Now, "'Prof_WBOpen_Timer_Event """ & LTrim(CStr(g_prof.handle)) & """'"
    
    If val(Application.Version) < 10 Then
        GoTo FunctionEnd
    End If
    
    'TREQ 3117337 - global add-in kill switch
    If IsAddinKillSwitchEnabled Then
        GoTo FunctionEnd
    End If
        
    originalUpdating = EXCEL.Application.ScreenUpdating
    EXCEL.Application.ScreenUpdating = False
    
    InitGlobals
    g_prof.Res = Prof_Mark(g_prof.handle, "EL_InitGlobals_Done_E")


    If IsLinkManagerV2Available Then
        Set BBPTv2_appHandler = New BBPTv2_ApplicationEvents
    Else
        Set appHandler = New ApplicationEvents
    End If
    
    EXCEL.Application.ScreenUpdating = originalUpdating
    
On Error GoTo FunctionEnd
    Set oPopup = Application.CommandBars("Worksheet Menu Bar").Controls("&View")
    
    oPopup.CommandBar.Controls("&Bloomberg Menu").Delete
        
FunctionEnd:
    ConditionallyRestoreRTDThottleInterval
    
    g_prof.Res = Prof_Mark(g_prof.handle, "EL_BUI_WbOpen_Done_E")
    
    popTrace "Workbook_Open"
End Sub




Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-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 = "Sheet2"
Attribute VB_Base = "0{00020820-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 = "Sheet3"
Attribute VB_Base = "0{00020820-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

#If VBA7 Then
Private Declare PtrSafe Function GetSessionOptions Lib "bbrtd.dll" () As String
#Else
Private Declare Function GetSessionOptions Lib "bbrtd.dll" () As String
#End If

Implements ITool

Private m_proxy As ToolProxy

' More magic about box changes

Private Sub Class_Initialize()
  pushTrace "Class_Initialize", "AboutBox.cls"
    If m_proxy Is Nothing Then
        Set m_proxy = New ToolProxy
        m_proxy.VBAWorkbookName = "BloombergUI"
        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(2)
    Parameters(0) = ""
    If isV3Enabled() Then
        Parameters(1) = "v3"
    Else
        Parameters(1) = "v2"
    End If
        If Not IsDisabledSessionOptionsDisplay() Then
        Parameters(2) = GetSessionOptions()
    End If

    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 Function LoadLocally(addinName As String) As Boolean
  pushTrace "LoadLocally", "AddinLoader.cls", addinName
    LoadLocally = True
    Dim addinPath As String
    
    addinPath = ThisWorkbook.path & "\" & addinName
    
    On Error GoTo failure
    Workbooks.Open (addinPath)
    popTrace "LoadLocally"
    Exit Function
    
failure:
    LoadLocally = False
    popTrace "LoadLocally"
End Function

Attribute VB_Name = "ApplicationEvents"
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

Dim WithEvents excelApp As Application
Attribute excelApp.VB_VarHelpID = -1
Dim SheetAutoColorShadow As String
Dim SheetAutoColor As String

Private Sub Class_Initialize()
  pushTrace "Class_Initialize", "ApplicationEvents.cls"
    Set excelApp = Application
    popTrace "Class_Initialize"
End Sub

Private Sub Class_Terminate()
    pushTrace "Class_Terminate", "ApplicationEvents.cls"
    Set excelApp = Nothing
    popTrace "Class_Terminate"
End Sub

Private Sub excelApp_NewWorkbook(ByVal wb As Workbook)
    pushTrace "excelApp_NewWorkbook", "ApplicationEvents.cls", wb
    BuildFormattingMenus_OnTime
    popTrace "excelApp_NewWorkbook"
End Sub

Private Sub excelApp_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim strWksName As String
    On Error Resume Next
    If InStr(Sh.name, " ") > 0 Then
        strWksName = Sh.Names("'" & Sh.name & "'" & "!" & AutoColor_RangeName_Wks).name
        Else
        strWksName = Sh.Names(Sh.name & "!" & AutoColor_RangeName_Wks).name
    End If
    If Err.Number = 0 Then
        Wks_SetChangeForAutoColorOn Sh, Target.address
    End If
    'If Not Sh Is Nothing Then
        'Wks_SetChangeForAutoColorOn Sh, Target.address
    'End If
End Sub
Private Sub excelApp_SheetActivate(ByVal Sh As Object)
    pushTrace "excelApp_SheetActivate", "ApplicationEvents.cls", Sh
    Dim wksName As String
    On Error Resume Next
    If SheetAutoColor <> "" Then
        If Not xlWksExists(Sh.Parent, SheetAutoColor) Then
            Application.DisplayAlerts = False
            Worksheets(SheetAutoColorShadow).Visible = True
            Worksheets(SheetAutoColorShadow).Delete
            Application.DisplayAlerts = True
        End If
    End If
    popTrace "excelApp_SheetActivate"
End Sub
Private Sub excelApp_SheetDeactivate(ByVal Sh As Object)
    pushTrace "excelApp_SheetDeactivate", "ApplicationEvents.cls", Sh
    Dim wksName  As String
    Dim nameString As String
    Dim nm       As EXCEL.name
    On Error Resume Next
    
    nameString = "'" & Sh.name & "'" & "!" & AutoColor_RangeName_Wks
    If xlNameExists(nameString) Then
        Set nm = Sh.Names(nameString)
        If xlWksExists(Sh.Parent, Mid(nm.RefersTo, 3, Len(nm.RefersTo) - 3)) Then
            wksName = Mid(nm.RefersTo, 3, Len(nm.RefersTo) - 3)
            SheetAutoColorShadow = wksName
            SheetAutoColor = Sh.name
            Else
            SheetAutoColorShadow = ""
            SheetAutoColor = ""
        End If
    End If
    popTrace "excelApp_SheetDeactivate"
End Sub

Private Sub excelApp_WorkbookAfterSave(ByVal wb As Workbook, ByVal success As Boolean)
    RestoreCreatedStateAllComponents wb
End Sub

Private Sub excelApp_WorkbookBeforeClose(ByVal wb As Workbook, Cancel As Boolean)
    pushTrace "excelApp_WorkbookBeforeClose", "ApplicationEvents.cls", wb, Cancel
On Error GoTo handleError
  
'    Dim strNm           As String
'    Dim strFullName     As String
'
'    strNm = FirstLinkedRangeName(Wb)
'    If Len(strNm) > 0 Then
'        strFullName = Wb.fullname
''        Cancel = True
'        Fire_UpdateLinkedRanges strFullName, strNm
'    End If
 
'    Dim bleHasAutoColor As Boolean
    
    Dim wnd As Window
    
    If Application.Visible Then
        If val(Application.Version) < 15 Then
            Application.EnableEvents = False
            Else ' for excel 2013
            For Each wnd In Application.Windows
                If UCase$(wnd.Caption) = UCase$(wb.name) Then
                    'wnd.Activate
                    wb.Activate
                    Else
                    ThisWorkbook.Activate
                End If
            Next wnd
        End If
        Else
        Application.EnableEvents = False
    End If

    If Not (wb Is Nothing) Then
        If wb.IsAddin = False And IsPowerToolsAvailable = True Then
            UpdateMyLinkedRanges_OnClose wb, Cancel
        End If
        
        If wb.IsAddin = False And Cancel = False Then
            ClearComponents_OnClose wb, Cancel
        End If
    End If
    
ExitHere:
    Application.EnableEvents = True
    popTrace "excelApp_WorkbookBeforeClose"
    Exit Sub
handleError:
    Gen_ErrHandle "ApplicationEvents.excelApp_WorkbookBeforeClose"
    Resume ExitHere
    popTrace "excelApp_WorkbookBeforeClose"
End Sub

Private Sub ClearComponents_OnClose(wb As Workbook, ByRef Cancel As Boolean)
    Dim Caption As String
   
    If Cancel = False Then
        ClearAllComponents wb
    End If
    
End Sub

Private Sub excelApp_WorkbookBeforeSave(ByVal wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    pushTrace "excelApp_WorkbookBeforeSave", "ApplicationEvents.cls", wb, SaveAsUI, Cancel
On Error GoTo handleError
    
    If Application.Visible Then
        If val(Application.Version) < 15 Then
            Application.EnableEvents = False
        End If
        Else
        Application.EnableEvents = False
    End If

    If xlTestGetActiveWbkWks() = True Or xlTestGetActiveWbkChartSht() = True Then
        If IsPowerToolsAvailable = True Then
            UpdateMyLinkedRanges_OnSave wb
'            If Wb.Saved = False Then
'                Cancel = StopSaveForAutoColor(Wb)
'            End If
        End If
    End If
    
    ClearAllComponents wb
    
ExitHere:
    Application.EnableEvents = True
    popTrace "excelApp_WorkbookBeforeSave"
    Exit Sub
handleError:
    Gen_ErrHandle "ApplicationEvents.excelApp_WorkbookBeforeSave"
    Resume ExitHere
    Resume
    popTrace "excelApp_WorkbookBeforeSave"
End Sub

Private Sub UpdateMyLinkedRanges_OnClose(wb As Workbook, _
                                         ByRef Cancel As Boolean)
    pushTrace "UpdateMyLinkedRanges_OnClose", "ApplicationEvents.cls", wb, Cancel
    
    Dim strNm           As String
    Dim strFullName     As String
    Dim strMsg          As String
    Dim MyResponse      As VbMsgBoxResult
    Dim nameCountTest   As Integer
    
    On Error Resume Next
    
    nameCountTest = wb.Names.count
    If Err.Number <> 0 Then
        Log_BBPTError "Workbook Empty Warning", "UpdateMyLinkedRanges_OnClose"
…

Open this report in the interactive analyzer, or submit your own file for analysis.