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

Static analysis result for SHA-256 5e013d983e4df0bb…

MALICIOUS

Office (OLE) / .DOC

201.5 KB Created: 2000-11-15 22:30:36 First seen: 2026-05-11
MD5: d343a76f1f33971b90b287a3a344f3b1 SHA-1: 87e0d7a37ef9f0dafceeefe1f99441e7efaccee9 SHA-256: 5e013d983e4df0bb738b5eb0265cc63216ce8dd94071c2ae9ab072bf90de74f4
80 Risk Score

Malware Insights

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

The sample is a macro-enabled Office document containing VBA code. A critical heuristic firing indicates that the VBA macro attempts self-replication by writing to the VBA project code, a common technique for malware to evade analysis or spread. The document body content appears to be a template for compensation reports, suggesting a lure for users to open and enable macros.

Heuristics 2

  • VBA macros detected medium 1 related finding 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
       ActiveWorkbook.VBProject.VBComponents(ModuleName).CodeModule.DeleteLines 1, _

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 14529 bytes
SHA-256: c9f4302078dc87e4eb20bb25df1b401a3c7dfb28fc2ed6812a1f6d8417a8a9ab
Preview script
First 1,000 lines of the extracted script
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 = "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

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 = "Main"
Option Explicit
Sub GetData()
Attribute GetData.VB_ProcData.VB_Invoke_Func = "r\n14"
GenerateReport
End Sub
Sub GetData2()
Attribute GetData2.VB_ProcData.VB_Invoke_Func = "e\n14"
GenerateReportA4
End Sub


Attribute VB_Name = "Sheet4"
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 = "Tools"
Option Explicit
Public Function GenerateReport() As Variant
Dim wks As Worksheet
Dim n As Integer
Dim sRawData, sReport, nHeader, nStart, nTotFont, MsgCell

Set wks = ActiveWorkbook.Worksheets("Application")
For n = 2 To 10
   If wks.Cells(n, 1) = "" Then Exit For
Next
n = n - 2
ReDim ReportList(1 To n) As Variant

For n = 2 To 10
   If wks.Cells(n, 1) = "" Then Exit For
   sRawData = wks.Cells(n, 1)
   sReport = wks.Cells(n, 2)
   nHeader = wks.Cells(n, 3)
   nStart = wks.Cells(n, 4)
   MsgCell = wks.Cells(n, 5)
   nTotFont = wks.Cells(n, 6)
   ReportList(n - 1) = Array(sRawData, sReport, nHeader, nStart, MsgCell, nTotFont)
Next

BuildReports ReportList

End Function
Private Sub BuildReports(aReports)
Dim Mode, n, runMode
Dim aSheet As Worksheet
Dim aRange As Range
Dim sRawData, sReport, nHeader, nStart, nTotFont, MsgCell

Application.ScreenUpdating = False
Set aSheet = ActiveWorkbook.ActiveSheet
Set aRange = Application.Selection
runMode = GetReportOptionCell("Run_Mode").Value

Mode = "Generate"
If IsTemplate() Then
   Mode = "Hide"
   If ActiveWorkbook.Worksheets("Options").Visible = xlSheetHidden Then Mode = "UnHide"
End If
 
For n = 1 To UBound(aReports)
   sRawData = aReports(n)(1):  sReport = aReports(n)(0):  nHeader = aReports(n)(2)
   nStart = aReports(n)(3): nTotFont = aReports(n)(5): MsgCell = aReports(n)(4)
   If Mode = "Generate" Then
      FillReportSheet sRawData, sReport, nHeader, nStart, 1, 3, MsgCell, nTotFont
      If runMode = "SINGLE" Then DeleteRawData sRawData, sReport, nHeader
   Else
      HideRawData sRawData, sReport, nHeader, Mode
   End If
Next

If Mode = "Generate" And runMode = "SINGLE" Then
   DeleteMacro "Main"
   DeleteMacro "Tools"
End If

Application.ScreenUpdating = True
On Error Resume Next
aSheet.Select
aRange.Select

End Sub
Private Sub FillReportSheet(ReportSheet, dataSheet, repHeaderRow, repRowStart, _
     dataHeaderRow, dataRowStart, MsgCell, TotalRowFontSize)

Dim repColNo, dataColNo, sFld, sFormula, sTotFormula
Dim repRowEnd, dataRowEnd, repTotalRow
Dim fRow, tRow, curFlag, rowCount, n, msg
Dim xx As Range
Dim wksData As Worksheet, wksRep As Worksheet

Set wksData = ActiveWorkbook.Worksheets(dataSheet)
Set wksRep = ActiveWorkbook.Worksheets(ReportSheet)

msg = wksRep.Range(MsgCell).Value
msg = vbReplace(msg, " ", "")
If InStr(msg, "CTRL+R") > 0 Then
   For n = 1 To 6
       wksRep.Rows(wksRep.Range(MsgCell).Row).Delete
   Next n
End If

Set xx = GetReportOptionCell("ROWS_" & wksData.Name)
rowCount = xx.Value * 1
If rowCount = 0 Then
   If UCase(wksData.Name) = "RAWDATA1" Then
      wksRep.Range(MsgCell).Value = "This report has no data"
   Else
      wksRep.Range(MsgCell).Value = "This report has no data because,"
      wksRep.Cells(wksRep.Range(MsgCell).Row + 1, wksRep.Range(MsgCell).Column).Value = _
          "you did not include breakout/history OR breakout/history does not exist."
      wksRep.Cells(wksRep.Range(MsgCell).Row + 1, wksRep.Range(MsgCell).Column).Font.ColorIndex = 3
      wksRep.Cells(wksRep.Range(MsgCell).Row + 1, wksRep.Range(MsgCell).Column).Font.Size = 14
      wksRep.Cells(wksRep.Range(MsgCell).Row + 1, wksRep.Range(MsgCell).Column).Font.Bold = True
   End If
   wksRep.Range(MsgCell).Font.ColorIndex = 3
   wksRep.Range(MsgCell).Font.Size = 14
   wksRep.Range(MsgCell).Font.Bold = True
   Exit Sub
End If

wksData.Activate
repRowEnd = repRowStart + rowCount - 1
dataRowEnd = dataRowStart + rowCount - 1
repTotalRow = repRowEnd + 2  'leave one extra blank line

For repColNo = 1 To 500
   
   sFld = wksRep.Cells(repHeaderRow, repColNo).Value
   sFormula = wksRep.Cells(repHeaderRow + 1, repColNo).Formula
   sTotFormula = wksRep.Cells(repHeaderRow + 2, repColNo).Formula
   
   If sFld = "" And sFormula = "" Then Exit For
   dataColNo = FindColumnNo(wksData, dataHeaderRow, sFld)
   
   '-----------------------1. Do the Report Total Row for all columns
   wksRep.Cells(repRowStart + 1, repColNo).Formula = sTotFormula
   wksRep.Cells(repRowStart + 1, repColNo).Copy wksRep.Cells(repTotalRow, repColNo)
   wksRep.Cells(repRowStart + 1, repColNo).ClearContents
   
   FormatTotalRow wksRep.Cells(repTotalRow, repColNo), TotalRowFontSize
   
   CopyFormats wksRep.Cells(repHeaderRow + 2, repColNo), wksRep.Cells(repTotalRow, repColNo)

   If dataColNo <> 0 Then  '----2. pick up the column from raw data
      wksRep.Range(wksRep.Cells(repRowStart, repColNo), wksRep.Cells(repRowEnd, repColNo)).Value = _
      wksData.Range(wksData.Cells(dataRowStart, dataColNo), wksData.Cells(dataRowEnd, dataColNo)).Value
   End If
   
   If sFormula <> "" Then    '---3. copy the formula down to all rows
      wksRep.Cells(repHeaderRow + 1, repColNo).Copy wksRep.Cells(repRowStart, repColNo)
      sFormula = wksRep.Cells(repRowStart, repColNo).Formula
      fRow = "$" & (repHeaderRow + 2)
      tRow = "$" & repTotalRow
      sFormula = vbReplace(sFormula, fRow, tRow)
      wksRep.Range(wksRep.Cells(repRowStart, repColNo), wksRep.Cells(repRowEnd, repColNo)).Formula = sFormula
   End If
   
Next

End Sub
Private Function FindColumnNo(oSheet As Worksheet, nRow, sValue) As Integer
Dim n As Integer
Dim sTmp As String

FindColumnNo = 0
If sValue = "" Then Exit Function
sValue = UCase(sValue)

For n = 1 To 500
   sTmp = UCase(Trim(oSheet.Cells(nRow, n).Value))
   If sTmp = "" Then Exit For
   If sTmp = sValue Then
      FindColumnNo = n
      Exit Function
   End If
Next

End Function
Private Function CopyFormats(rFrom As Range, rTo As Range) As Integer

'rFrom.Copy
'rTo.PasteSpecial xlPasteFormats

rTo.Interior.Color = rFrom.Interior.Color
rTo.Font.Size = rTo.Font.Size

End Function
Private Function vbReplace(ByVal String1 As String, ByVal String2 As String, ByVal RepString As String)

Dim I As Integer
I = 1
Do
  If (I > Len(String1)) Then Exit Do
  I = InStr(I, String1, String2)
  If I Then
     String1 = Left$(String1, I - 1) + RepString + Mid$(String1, I + Len(String2))
     I = I + 2
  End If
Loop While I
vbReplace = String1
 
End Function
Private Sub FormatTotalRow(xRange As Range, nFontSize)

xRange.Borders(xlDiagonalDown).LineStyle = xlNone
xRange.Borders(xlDiagonalUp).LineStyle = xlNone
xRange.Borders(xlEdgeLeft).LineStyle = xlNone

With xRange.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
With xRange.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
    
xRange.Borders(xlEdgeRight).LineStyle = xlNone
xRange.Borders(xlInsideVertical).LineStyle = xlNone
xRange.Font.Size = nFontSize

End Sub
Private Function GetReportOptionCell(sValue) As Range
Dim n As Integer
Dim sTmp As String
Dim oSheet As Worksheet

sValue = UCase(sValue)
Set oSheet = ActiveWorkbook.Worksheets("Options")

For n = 1 To 50
   sTmp = UCase(Trim(oSheet.Cells(n, 1).Value))
   If sTmp = sValue Then
      Set GetReportOptionCell = oSheet.Cells(n, 2)
      Exit Function
   End If
Next
Set GetReportOptionCell = oSheet.Cells(50, 2)

End Function
Private Function IsTemplate()
Dim xx As Range

IsTemplate = False
Set xx = GetReportOptionCell("Recalculate")
If xx.Value = "" Then
   IsTemplate = True
End If

End Function
Private Function HideRawData(ReportSheet, dataSheet, HeaderRow, Mode)

If Mode = "Hide" Then
   ActiveWorkbook.Worksheets("Options").Visible = xlSheetHidden
   ActiveWorkbook.Worksheets("Population").Visible = xlSheetHidden
   ActiveWorkbook.Worksheets("Application").Visible = xlSheetHidden
   ActiveWorkbook.Worksheets(dataSheet).Visible = xlSheetHidden
   ActiveWorkbook.Worksheets(ReportSheet).Rows(HeaderRow).Hidden = True
   ActiveWorkbook.Worksheets(ReportSheet).Rows(HeaderRow + 1).Hidden = True
   ActiveWorkbook.Worksheets(ReportSheet).Rows(HeaderRow + 2).Hidden = True
Else
   ActiveWorkbook.Worksheets("Options").Visible = xlSheetVisible
   ActiveWorkbook.Worksheets("Population").Visible = xlSheetVisible
   ActiveWorkbook.Worksheets("Application").Visible = xlSheetVisible
   ActiveWorkbook.Worksheets(dataSheet).Visible = xlSheetVisible
   ActiveWorkbook.Worksheets(ReportSheet).Rows(HeaderRow).Hidden = False
   ActiveWorkbook.Worksheets(ReportSheet).Rows(HeaderRow + 1).Hidden = False
   ActiveWorkbook.Worksheets(ReportSheet).Rows(HeaderRow + 2).Hidden = False
End If

ActiveWorkbook.Worksheets(ReportSheet).Activate

End Function
Private Function DeleteRawData(ReportSheet, dataSheet, HeaderRow)
   
   ActiveWorkbook.Worksheets(ReportSheet).Rows(HeaderRow).Delete
   ActiveWorkbook.Worksheets(ReportSheet).Rows(HeaderRow).Delete
   ActiveWorkbook.Worksheets(ReportSheet).Rows(HeaderRow).Delete
   With ActiveWorkbook.Worksheets(dataSheet)
       .Range(.Cells(1, 1), .Cells(50000, 100)).Delete
       .Range(.Cells(1, 1), .Cells(50000, 100)).Delete
   End With
   
End Function
Private Function DeleteMacro(ModuleName)
   
   ActiveWorkbook.VBProject.VBComponents(ModuleName).CodeModule.DeleteLines 1, _
      ActiveWorkbook.VBProject.VBComponents(ModuleName).CodeModule.CountOfLines

End Function

Public Function GenerateReportA4() As Variant
Dim wks As Worksheet
Dim n As Integer
Dim sRawData, sReport, nHeader, nStart, nTotFont, MsgCell

Set wks = ActiveWorkbook.Worksheets("Application")
For n = 2 To 10
   If wks.Cells(n, 1) = "" Then Exit For
Next
n = n - 2
ReDim ReportList(1 To n) As Variant

For n = 2 To 10
   If wks.Cells(n, 1) = "" Then Exit For
   sRawData = wks.Cells(n, 1)
   sReport = wks.Cells(n, 2)
   nHeader = wks.Cells(n, 3)
   nStart = wks.Cells(n, 4)
   MsgCell = wks.Cells(n, 5)
   nTotFont = wks.Cells(n, 6)
   ReportList(n - 1) = Array(sRawData, sReport, nHeader, nStart, MsgCell, nTotFont)
Next

BuildReportsA4 ReportList

End Function
Private Sub BuildReportsA4(aReports)
Dim Mode, n, runMode
Dim aSheet As Worksheet
Dim aRange As Range
Dim sRawData, sReport, nHeader, nStart, nTotFont, MsgCell

Application.ScreenUpdating = False
Set aSheet = ActiveWorkbook.ActiveSheet
Set aRange = Application.Selection
runMode = GetReportOptionCell("Run_Mode").Value

Mode = "Generate"
If IsTemplate() Then
   Mode = "Hide"
   If ActiveWorkbook.Worksheets("Options").Visible = xlSheetHidden Then Mode = "UnHide"
End If
 
For n = 1 To UBound(aReports)
   sRawData = aReports(n)(1):  sReport = aReports(n)(0):  nHeader = aReports(n)(2)
   nStart = aReports(n)(3): nTotFont = aReports(n)(5): MsgCell = aReports(n)(4)
   If Mode = "Generate" Then
      FillReportSheet sRawData, sReport, nHeader, nStart, 1, 3, MsgCell, nTotFont
      If runMode = "SINGLE" Then DeleteRawData sRawData, sReport, nHeader
   Else
      HideRawData sRawData, sReport, nHeader, Mode
   End If
   Dim wksRep2 As Worksheet
   Set wksRep2 = ActiveWorkbook.Worksheets(aReports(n)(1))
   wksRep2.PageSetup.PaperSize = xlPaperA4
Next

If Mode = "Generate" And runMode = "SINGLE" Then
   DeleteMacro "Main"
   DeleteMacro "Tools"
End If

Application.ScreenUpdating = True
On Error Resume Next
aSheet.Select
aRange.Select

End Sub

Attribute VB_Name = "Sheet21"
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 = "Sheet5"
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 = "Sheet6"
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 = "Sheet7"
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 = "Sheet51"
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.