Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 58b530be7bc9ed16…

MALICIOUS

Office (OOXML)

304.1 KB Created: 2021-07-27 09:45:00 UTC Authoring application: Microsoft Office Word 15.0000 First seen: 2026-06-04
MD5: 192b70891de0d54af6fa46bd35a5fd87 SHA-1: dcf6430ae67fbfbdf09e5c4421b1ad82b1918431 SHA-256: 58b530be7bc9ed16fa28a68202e21aa5b9e5508a72034faf78e6e62bccf10a8b
132 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1566.001 Spearphishing Attachment T1203 Exploitation for Client Execution

This OOXML document contains a VBA project with a Document_Open macro that utilizes Shell calls, indicating an attempt to execute arbitrary code. The presence of a large encoded blob and the critical heuristic for potential Shell calls strongly suggest the macro is designed to download and execute a second-stage payload. The specific VBA code appears to be obfuscated and truncated, preventing a more detailed analysis of its exact function, but the overall intent is clear.

Heuristics 6

  • VBA project inside OOXML medium 3 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
    Shell (IIIIlIlIlIIlIlllIIIIIllIlIllIllIIIIIllIIIllIllllll)
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Triggers on the COMBINATION of two tokens co-occurring in the same compiled VBA/cache stream: an auto-execution entry point (Auto_Open / AutoOpen / Document_Open / Workbook_Open / Auto_Close / AutoClose) AND a shell/download/object-execution token (Shell, CreateObject, GetObject, PowerShell, cmd.exe, URLDownloadToFile, WinHttp, XMLHTTP, ADODB.Stream, ShellExecute, ExecuteExcel4Macro). Neither token alone fires it — it is the pairing that flags p-code-only or source-extraction-failure macro documents where the visible VBA source is unavailable. The matched tokens are named in the detail line below.
  • Document_Open macro low OLE_VBA_DOCOPEN
    Document_Open macro
    Matched line in script
    Sub Document_Open()
  • Suspicious extracted artifact info 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://schemas.microsoft.com/office/word/2010/wordprocessingCanvas In document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/markup-compatibility/2006In document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/officeDocument/2006/relationshipsIn document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/officeDocument/2006/mathIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingDrawingIn document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawingIn document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/wordprocessingml/2006/mainIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordmlIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2012/wordmlIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingGroupIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingInkIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2006/wordmlIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingShapeIn document text (OOXML body / shared strings)

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 942822 bytes
SHA-256: 1733b64c5db1813a12f09acd586ce59f54d314bbeb4bb0492914db1151ac9a1d
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact contains 4 long base64-like blob(s).
Preview script
First 1,000 lines of the extracted script
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
Sub IllllIllIllIlIIIIIIIlllIIIlIIIIllIllIIlIIIlIIIlIll()
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String

    If TypeName(Selection) <> "uju" Then
        MsgBox "Shy."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0

    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)


        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area

    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String


    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0


    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)

        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area


    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String


    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0


    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)


        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area


    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String

    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0

    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)


        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area

    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String


    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0


    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)

        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area


    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String


    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0


    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)


        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area


    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String

    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0

    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)


        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area

    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String


    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0


    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)

        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area


    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String


    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0


    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)


        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area


    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String

    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0

    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)


        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area

    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String


    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0


    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)

        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area


    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String


    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0


    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)


        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area


    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String

    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0

    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType


    Set UnionRange = Selection.Areas(1)

    For Each Area In Selection.Areas
        CurrentType = AreaType(Area)


        If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
        Set UnionRange = Union(UnionRange, Area)


        If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
    Next Area

    For Each Area In UnionRange.Areas
        Select Case AreaType(Area)
            Case "Row"
                NumRows = NumRows + Area.Rows.Count
            Case "Column"
                NumCols = NumCols + Area.Columns.Count
            Case "Worksheet"
                NumCols = NumCols + Area.Columns.Count
                NumRows = NumRows + Area.Rows.Count
            Case "Block"

        End Select
     Next Area


    NumCells = UnionRange.CountLarge

    Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
    Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
    Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
    Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
    Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
    Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
    MsgBox Msg, vbInformation, SelType
    Dim NumCols As Integer
    Dim NumRows As Long
    Dim NumBlocks As Integer
    Dim NumCells As Double
    Dim NumAreas As Integer
    Dim SelType As String
    Dim FirstAreaType As String
    Dim CurrentType  As String
    Dim WhatSelected As String
    Dim UnionRange As Range
    Dim Area As Range
    Dim Msg As String


    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If


    NumCols = 0
    NumRows = 0
    NumBlocks = 0
    NumCells = 0


    NumAreas = Selection.Areas.Count
    If NumAreas = 1 Then
        SelType = "Single Selection"
    Else
        SelType = "Multiple Selection"
    End If

    FirstAreaType = AreaType(Selection.Areas(1))
    WhatSelected = FirstAreaType
…
vbaProject_00.bin vba-project OOXML VBA project: word/vbaProject.bin 1397760 bytes
SHA-256: 8402d708381fc5091a4d90dc75e2a8760be112b0498d40feabd70ba9ecbc14e8
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact contains 4 long base64-like blob(s).

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