Malicious Office (OLE) / .XLS — malware analysis report

Static analysis result for SHA-256 0009ecfbc9a20cca…

MALICIOUS

Office (OLE) / .XLS

58.5 KB Created: 1996-10-14 23:33:28 Authoring application: Microsoft Excel First seen: 2026-05-10
MD5: 256409765a955e5f68a5efa44e48cbe8 SHA-1: 89df8c70b41fcc77292e2f131bd9bf9e637c3e33 SHA-256: 0009ecfbc9a20cca660641913a3c117a566afe6e149ba601d758b12f33b57cd4
130 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1547.001 Registry Run Keys / Startup Folder

This Excel file contains a Workbook_Open VBA macro that is designed to reformat the document and save it under a new name, effectively hiding its malicious nature. The macro also includes functionality to delete itself after execution, making analysis more difficult. The presence of CreateObject and self-replication heuristics suggests a more complex malicious intent, possibly related to establishing persistence or downloading additional payloads, though these specific actions are not fully detailed in the provided script.

Heuristics 5

  • VBA macros detected medium 3 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • 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
        ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.DeleteLines 1, iLines
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        Set oFSO = CreateObject("Scripting.FileSystemObject")
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Private Sub Workbook_Open()
  • 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://ocsp.verisign.com0 In document text (OLE body)
    • http://crl.verisign.com/tss-ca.crl0In document text (OLE body)
    • http://crl.verisign.com/ThawteTimestampingCA.crl0In document text (OLE body)
    • https://www.verisign.com/rpaIn document text (OLE body)
    • https://www.verisign.com/rpa01In document text (OLE body)
    • http://crl.verisign.com/pca3.crl0In document text (OLE body)
    • http://CSC3-2004-crl.verisign.com/CSC3-2004.crl0DIn document text (OLE body)
    • https://www.verisign.com/rpa0In document text (OLE body)
    • http://CSC3-2004-aia.verisign.com/CSC3-2004-aia.cer0In document text (OLE body)

Related samples 8

Ranked by shared artifacts, heuristics, extracted URLs, CVEs, and signatures.

Full JSON: related samples API

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas🔏 SignedVBA project digital signature
Covers VBA source only — not the compiled p-code. A digital signature does not by itself mean the macro is safe.		 vba-macro oletools.olevba.extract_macros (decoded VBA source) 8724 bytes
SHA-256: 7f150e5ce60ea58cc480eeccc9fb2bdb1c8bb8c53efa79814b7be7d2917ee1a1
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
Private Sub Workbook_Open()
    Format
End Sub

Public Sub Format()
       
    'Create the wait message
    CreateWaitMessage
    
    CheckAnyWorkBookIsOpen

    Application.ScreenUpdating = False

    SetNumberFormat
    InitialSetup
    RemoveDuplicateProdFamilyDesc
    RemoveDuplicateSectionDesc
    CreateSectionHeaders
    DeleteUnwantedColumnsRows
    SetColumnsWidth

    'Positioning
    Range("A1:A1").Select
    
    SaveAsFormattedFile
    
    'Delete the wait message now
    DeleteWaitMessage

    'Now delete all the code in macro
    DeleteMacro
    
    
    
    
End Sub

Private Sub SaveAsFormattedFile()
    
    Dim sFileName As String
    Dim oFSO As Object
    Dim oFile As Object
    
    sFileName = ActiveWorkbook.FullName
    sFileName = Replace(sFileName, "_unformatted", "")
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FileExists(sFileName) = True Then
        Set oFile = oFSO.GetFile(sFileName)
        oFile.Delete
    End If
    ActiveWorkbook.SaveAs sFileName, xlNormal, "", "", False, False
End Sub
Private Sub DeleteMacro()

    'Delete this macro
    Dim iLines As Integer
    iLines = ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines
    ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.DeleteLines 1, iLines
    ThisWorkbook.Save

End Sub


Private Sub SetNumberFormat()
    
      Dim iRowCnt As Integer
      Dim SourceRange As Range
      Dim fillRange As Range
      
      For iColCnt = 8 To Sheet1.UsedRange.Columns.Count
            For iRowCnt = 4 To Sheet1.UsedRange.Rows.Count
                Cells(iRowCnt, iColCnt).Value = Val(Cells(iRowCnt, iColCnt).Value)
                If Cells(iRowCnt, iColCnt).Value = 0 Then
                    Cells(iRowCnt, iColCnt).Value = ""
                End If
            Next
      Next
   
End Sub

Private Sub SetColumnsWidth()
    
    'Produt family
    Cells(1, 1).ColumnWidth = 56.71
    
    'Care Pack
    Cells(1, 2).ColumnWidth = 9
    
    'Service Level
    Cells(1, 3).ColumnWidth = 76.51
    
    'SPL
    Cells(1, 4).ColumnWidth = 3.86
    
    'WW & Ref
    Cells(1, 5).ColumnWidth = 9.29
    
End Sub

Private Sub DeleteUnwantedColumnsRows()
    
    'Delete unwanted rows
    Columns("B:C").Delete Shift:=xlToLeft
    
    'Delete unwanted rows
    Rows("1:3").Delete Shift:=xlUp

End Sub
Private Sub InitialSetup()
    
    Columns("C:C").Delete Shift:=xlToLeft
   
End Sub
Private Sub RemoveDuplicateProdFamilyDesc()

    'Loop thru the column 2 and remove duplicate items
    Dim iRowCnt As Integer
    Dim sCurrentProdFamilyDesc As String
    Dim sPrevProdFamilyDesc As String
    
    sCurrentProdFamilyDesc = "X"
    sPrevProdFamilyDesc = "Y"
    
    For iRowCnt = 4 To Sheet1.UsedRange.Rows.Count
        sCurrentProdFamilyDesc = Cells(iRowCnt, 1)
        If sCurrentProdFamilyDesc <> sPrevProdFamilyDesc Then
            sPrevProdFamilyDesc = Cells(iRowCnt, 1)
        Else
            Cells(iRowCnt, 1) = ""
        End If
    Next

End Sub
Private Sub RemoveDuplicateSectionDesc()
    
    'Loop thru the column 2 and remove duplicate items
    Dim iRowCnt As Integer
    Dim sCurrentSectionDesc As String
    Dim sPrevSectionDesc As String
    
    sCurrentSectionDesc = "X"
    sPrevSectionDesc = "Y"
    
    For iRowCnt = 4 To Sheet1.UsedRange.Rows.Count
        sCurrentSectionDesc = Cells(iRowCnt, 2)
        If sCurrentSectionDesc <> sPrevSectionDesc Then
            sPrevSectionDesc = Cells(iRowCnt, 2)
            Cells(iRowCnt, 3).Value = "H"
        Else
            Cells(iRowCnt, 2) = ""
        End If
    Next

End Sub

Private Sub CreateSectionHeaders()

    Dim rRange As Range
    Set rRange = Range(Cells(1, 3), Cells(Sheet1.UsedRange.Rows.Count, 3))

    'Clear section_description, hw_family_code
    Cells(1, 2).Value = ""
    Cells(1, 3).Value = ""
    
    With rRange
    Set c = .Find("H", LookIn:=xlValues)
        If Not c Is Nothing Then
            Do
                c.Value = ""
               
                c.EntireRow.Insert
                c.EntireRow.Insert
                c.EntireRow.Insert
                c.EntireRow.Insert
                
                For iColCnt = 7 To Sheet1.UsedRange.Columns.Count
                    Cells(c.Row - 3, iColCnt).Value = Cells(1, iColCnt).Value
                    Cells(c.Row - 2, iColCnt).Value = Cells(3, iColCnt).Value
                Next
                
                For iColCnt = 1 To 6
                    Cells(c.Row - 2, iColCnt).Value = Cells(1, iColCnt).Value
                Next
                
                'Put header
                Cells(c.Row - 3, 1).Value = Cells(c.Row, 2).Value
                Cells(c.Row - 3, 1).Font.Bold = True

                
                Cells(c.Row - 3, 1).EntireRow.Interior.ColorIndex = 6
                Cells(c.Row - 2, 1).EntireRow.Interior.ColorIndex = 6
                
                Set c = .FindNext(c)
            Loop While Not c Is Nothing
        End If
    End With
    
End Sub


Private Sub CreateWaitMessage()

    ActiveWindow.Zoom = 100
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 172#, 172#). _
        Select
    Selection.ShapeRange.ScaleWidth 8.67, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 5.49, msoFalse, msoScaleFromTopLeft
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 243#, 195.75, _
        249#, 50.25).Select
    Selection.Characters.Text = "Please wait ..."
    With Selection.Characters(Start:=1, Length:=15).Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.HorizontalAlignment = xlCenter
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.Font.Bold = True
    'ActiveSheet.Shapes("Rectangle 2").Select
End Sub

Private Sub DeleteWaitMessage()

    'Fix for the excel 2007
    'ActiveSheet.Shapes("Text Box 2").Select
    If Val(Mid(Application.Version, 1, InStr(1, Application.Version, ".") - 1)) > 11 Then
        ActiveSheet.Shapes("TextBox 2").Select
    Else
        ActiveSheet.Shapes("Text Box 2").Select
    End If
    'Fix for the excel 2007 Till here
    
    Selection.Characters.Text = "Please wait ..."
    With Selection.Characters(Start:=1, Length:=15).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.Delete
    ActiveSheet.Shapes("Rectangle 1").Select
    Selection.Delete
End Sub

Private Sub CheckAnyWorkBookIsOpen()
    If Application.Workbooks.Count > 1 Then
        If MsgBox("All other open Excel workbooks should be closed. Click 'Yes' to save and close all other open workbooks and continue processing. Click 'No' if you want to close all open workbooks manually and then run this process again.", vbYesNo, "CReST PL") = vbYes Then
            For Each oWB In Application.Workbooks
                If oWB.FullName <> ThisWorkbook.FullName Then
                    oWB.Close True
                End If
            Next
        Else
            ThisWorkbook.Close False
        End If
    End If
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

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