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

Static analysis result for SHA-256 191679976b77f3b9…

MALICIOUS

Office (OLE) / .XLS

62.5 KB Created: 2023-02-08 01:01:55 Authoring application: Microsoft Excel First seen: 2026-06-22
MD5: c0c264b65a29988decf30afff946cba1 SHA-1: db1ab8324d66db68ba94f117d001a100e3b11b05 SHA-256: 191679976b77f3b9aacf9e52acf74df558c77547a45770209629e7fd0a1bc012
120 Risk Score

Heuristics 3

  • VBA macros detected medium 2 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • VBA email-worm self-replication (Outlook mass-mailer) critical OLE_VBA_EMAIL_WORM_SELF_REPLICATION
    VBA macro drives Outlook to mass-mail itself: it automates Outlook.Application, programmatically creates a mail item, and spreads by attaches a file to the outgoing message, sends the message programmatically. Harvesting recipients from the address book / inbox and auto-attaching the carrier to outgoing messages is the defining behavior of the Melissa / LoveLetter / W97M mass-mailer worm lineage — there is no benign document use, independent of any AV signature.
    Matched line in script
        Set objMail = objOutlook.CreateItem(olMailItem)
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        Set objOutlook = CreateObject("outlook.application")

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 5645 bytes
SHA-256: b990140153d407a3e08c5ba6803cb253d9f20dc1c98ba0813374363ab198f712
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "Sheet8"
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_Control = "CommandButton2, 1, 0, MSForms, CommandButton"
Attribute VB_Control = "CommandButton1, 2, 1, MSForms, CommandButton"
Private Sub CommandButton1_Click()

Dim checkdata
    checkdata = Cells(4, 3).Value
    If checkdata = Null Or checkdata = 0 Or checkdata = "" Then
        MsgBox ("船名不能为空，请输入后再发送！")
        Exit Sub
    End If
    
    checkdata = Cells(4, 6).Value
    If checkdata = Null Or checkdata = 0 Or checkdata = "" Then
        MsgBox ("航次不能为空，请输入后再发送！")
        Exit Sub
    End If
    
    checkdata = Cells(5, 3).Value
    If checkdata = Null Or checkdata = "" Then
        MsgBox ("开始装卸时间不能为空，请输入后再发送！")
        Exit Sub
    End If
    
    checkdata = Cells(5, 7).Value
    If checkdata = Null Or checkdata = "" Then
        MsgBox ("港口不能为空，请输入后再发送！")
        Exit Sub
    End If
    
    checkdata = Cells(6, 3).Value
    If checkdata = Null Or checkdata = "" Then
        MsgBox ("港序不能为空，请输入后再发送！")
        Exit Sub
    End If
    
    
    checkdata = Cells(4, 10).Value
    If checkdata = Null Or checkdata = 0 Or checkdata = "" Then
        MsgBox ("预计完货时间不能为空，请输入后再发送！")
        Exit Sub
    End If
    
    Dim shipname
    shipname = Cells(4, 3).Value
    If shipname = Null Or shipname = 0 Then
        shipname = ""
    End If
    Dim voyno
    voyno = Cells(4, 6).Value
    If voyno = Null Or voyno = 0 Then
        voyno = ""
    End If
    
    Dim filen
    filen = Application.GetSaveAsFilename(InitialFileName:=shipname + "" + voyno + "" + Cells(2, 3).Value + "" + Format(Now(), "yymmddhhMMss") + ".xls", FileFilter:="工作薄文件(*.xls),*.xls", Title:="当前工作表另存为")
    If filen = False Then End
    
    Dim filefmt
    If Application.VERSION >= 12 Then
        filefmt = 56
    Else
        filefmt = 43
    End If
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=filen, FileFormat:=filefmt, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Private Sub CommandButton2_Click()
On Error Resume Next
    Dim objOutlook As Object
    Dim objMail As Object
    
    Dim checkdata
    checkdata = Cells(4, 3).Value
    If checkdata = Null Or checkdata = 0 Or checkdata = "" Then
        MsgBox ("船名不能为空，请输入后再发送！")
        Exit Sub
    End If
    
    checkdata = Cells(4, 6).Value
    If checkdata = Null Or checkdata = 0 Or checkdata = "" Then
        MsgBox ("航次不能为空，请输入后再发送！")
        Exit Sub
    End If
    
    checkdata = Cells(5, 3).Value
    If checkdata = Null Or checkdata = "" Then
        MsgBox ("开始装卸时间不能为空，请输入后再发送！")
        Exit Sub
    End If
    
    checkdata = Cells(5, 7).Value
    If checkdata = Null Or checkdata = "" Then
        MsgBox ("港口不能为空，请输入后再发送！")
        Exit Sub
    End If
    
    checkdata = Cells(6, 3).Value
    If checkdata = Null Or checkdata = "" Then
        MsgBox ("港序不能为空，请输入后再发送！")
        Exit Sub
    End If
    
    checkdata = Cells(4, 10).Value
    If checkdata = Null Or checkdata = 0 Or checkdata = "" Then
        MsgBox ("预计完货时间不能为空，请输入后再发送！")
        Exit Sub
    End If
    
    MsgBox ("此功能调用OUTLOOK发送邮件，如果不能使用OUTLOOK发送邮件，请使用另存为按钮保存附件后手工发送邮件至report@jlepc.com.cn")
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ActiveSheet.Copy
    Dim filen
    Dim datefmt
    datefmt = Format(Now(), "yymmddhhMMss") + ".xls"
    
    Dim filefmt
    If Application.VERSION >= 12 Then
        filefmt = 56
    Else
        filefmt = 43
    End If
    
    filen = ThisWorkbook.FullName
    Dim shipname
    shipname = Cells(4, 3).Value
    If shipname = Null Or shipname = 0 Then
        shipname = ""
    End If
    Dim voyno
    voyno = Cells(4, 6).Value
    If voyno = Null Or voyno = 0 Then
        voyno = ""
    End If
    filen = "c:\" + shipname + voyno + Cells(2, 3).Value + datefmt
    
    ActiveWorkbook.SaveAs Filename:=filen, FileFormat:=filefmt, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
    Set objOutlook = CreateObject("outlook.application")
    Set objMail = objOutlook.CreateItem(olMailItem)
    With objMail
        .To = "report@jlepc.com.cn"
        .CC = "ldsctc@jlepc.com.cn;" + "ldsmgm@jlepc.com.cn;" + "ldsgen@jlepc.com.cn;" + "zhangy2@jlepc.com.cn;"
        .Subject = shipname + " " + voyno + " " + Cells(2, 3).Value + " 报文信息"
        .Body = "船舶发送报文"
        .Attachments.Add filen
        .Send
    End With
    
    Set objOutlook = Nothing
End Sub

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