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

Static analysis result for SHA-256 01c1a9925b9c17eb…

MALICIOUS

Office (OLE) / .XLS

2.14 MB First seen: 2026-05-13
MD5: 61941c61d85a1e8680b9875c030bda85 SHA-1: e8b610f12dc1a74d603454fb5daf77a429b5ff27 SHA-256: 01c1a9925b9c17ebd839a110e0a64cf62a2bfe3e54223e53144cb58f0dbf86e6
280 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1105 Ingress Tool Transfer T1204.002 Malicious File

The sample is a malicious Excel file containing a large VBA macro. The macro is designed to execute a command that downloads and runs a second-stage payload, indicated by the 'OLE_VBA_BITSTRANSFER_DROPPER' heuristic. The presence of 'WEBSHELL_PHP' and 'OLE_VBA_SHELL' heuristics suggests the downloaded payload is likely a PHP webshell, enabling remote code execution.

Heuristics 10

  • VBA macros detected medium 6 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
        TaskID = Shell(fName, 2) '6
  • VBA stages a PowerShell/LOLBin download-and-run command critical OLE_VBA_BITSTRANSFER_DROPPER
    The macro assembles a download command using a PowerShell or LOLBin download primitive (Start-BitsTransfer, Invoke-WebRequest, Net.WebClient, bitsadmin, certutil, ...) that fetches a remote payload, then executes it -- writing it to a script file and running it, or launching it directly from an auto-exec handler. The keywords are commonly split with PowerShell backtick / cmd caret escapes to evade scanners; this detection de-escapes the source first. A high-confidence downloader/dropper, stronger than the individual Shell / download keywords on their own.
    Matched line in script
    Private Sub Workbook_Open()
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
                Set fs = CreateObject("Scripting.FileSystemObject")
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Triggers on the COMBINATION of two tokens co-occurring in the same compiled VBA/cache stream: an auto-execution entry point (Auto_Open / AutoOpen / Document_Open / Workbook_Open / Auto_Close / AutoClose) AND a shell/download/object-execution token (Shell, CreateObject, GetObject, PowerShell, cmd.exe, URLDownloadToFile, WinHttp, XMLHTTP, ADODB.Stream, ShellExecute, ExecuteExcel4Macro). Neither token alone fires it — it is the pairing that flags p-code-only or source-extraction-failure macro documents where the visible VBA source is unavailable. The matched tokens are named in the detail line below.
  • 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
    Sub auto_open()
  • PHP webshell / backdoor source high WEBSHELL_PHP
    The file contains PHP server-side code with the signature of a webshell/backdoor (request input fed to a command/code-exec sink). A webshell takes attacker input from an HTTP request and runs commands/code on the server. Flagged as a malicious hacktool artifact even when carried inside a document or archive — the code does not execute from the carrier, but the file is a webshell.
  • 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 http://allenbrowne.com In document text (OLE body)
    • http://www.lazerwire.com/2011/11/excel-vba-download-files-from-internet.htmlIn document text (OLE body)
    • http://www.ozgrid.com/forum/showthread.php?t=147881In document text (OLE body)
    • http://www.lazerwire.com/2011/11/excel-vba-re-throw-errorexception.htmlIn document text (OLE body)
    • http://�dF/�v�uingDIn document text (OLE body)
    • http://www.chem.mtu.edu/~tbco/cm3450/Compressibility_from_Redlich_Kwong.pdf4Xye�w�In document text (OLE body)
    • http://www.answers.com/topic/getcurrentdirectory#ixzz2fNTvdKGcIn document text (OLE body)
    • http://newtonexcelbach.wordpress.com/2010/04/28/automating-chart-scale-limits/In document text (OLE body)
    • http://www.google.comIn document text (OLE body)
    • http://forums.whirlpool.net.au/archive/1312914In document text (OLE body)
    • http://en.wikipedia.org/wiki/Bilinear_interpolationIn document text (OLE body)
    • http://www.fsf.org/licensing/licensesIn document text (OLE body)
    • http://www.chem.mtu.edu/~tbco/cm3450/Compressibility_from_Redlich_Kwong.pdfIn document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 2168397 bytes
SHA-256: 497c1e745630e5018369ffd8bcfa916eb22f60caa0e241173e7f84d9fb9dd91a
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact contains 2 long base64-like blob(s).
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()
    Call Init_Workbook
End Sub


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 = "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 = "Chem"
Option Base 1
'
'
' Eq. 90: cp0/R=a1+a2T+a3*T^2+a4*T^3+a5*T^4
' EQ90
Public Function fneq90(Tref As Double, alo As Range, ahi As Range, _
      Optional usecorrection As Boolean = True) As Double
   Dim sum As Double
   Dim blo As Variant
   Dim bhi As Variant
   Dim i As Integer
   
   blo = alo.value
   bhi = ahi.value
   
   sum = 0#
   If usecorrection Then
      If Tref > 1000 Then
         sum = sum + bhi(1, 7)
      Else
         sum = sum + blo(1, 7)
      End If
   End If
   For i = 1 To 5
      If Tref > 1000 Then
         sum = sum + bhi(1, i) * Tref ^ (i - 1)
      Else
         sum = sum + blo(1, i) * Tref ^ (i - 1)
      End If
   Next i
   fneq90 = sum
End Function

Public Function fneq90a(Tref As Double, alo As Range, ahi As Range, _
      Optional usecorrection As Boolean = True) As Double
   Dim sum As Double
   Dim blo As Variant
   Dim bhi As Variant
   Dim i As Integer
   
   blo = alo.value
   bhi = ahi.value
   
   sum = 0#
   If usecorrection Then
      If Tref > 1000 Then
         sum = sum + bhi(1, 7)
      Else
         sum = sum + blo(1, 7)
      End If
   End If
   For i = 1 To 5
      If Tref > 1000 Then
         sum = sum + bhi(1, i) * Tref ^ (i - 1)
      Else
         sum = sum + blo(1, i) * Tref ^ (i - 1)
      End If
   Next i
   fneq90a = sum
End Function


' Eq. 91: H0_T/(RT)=a1+a2/2*T+a3/3*T^2+a4/4*T^3+a5/5*T^4+a6/T
' EQ91
Public Function fneq91(Tref As Double, alo As Range, ahi As Range, _
      Optional usecorrection As Boolean = True, _
      Optional userangeadjust As Boolean = True) As Double
   Dim sum As Double
   Dim blo As Variant
   Dim bhi As Variant
   Dim i As Integer
   
   blo = alo.value
   bhi = ahi.value
   
   sum = 0#
   If usecorrection Then
      If Tref > 1000 Then
         sum = sum + bhi(1, 7)
      Else
         sum = sum + blo(1, 7)
      End If
   End If
   For i = 1 To 5
      If Tref > 1000 Then
         sum = sum + bhi(1, i) * (Tref ^ (i - 1)) / CDbl(i)
      Else
         sum = sum + blo(1, i) * (Tref ^ (i - 1)) / CDbl(i)
      End If
   Next i
   If userangeadjust Then
      If Tref > 1000 Then
         sum = sum + bhi(1, 6) / Tref
      Else
         sum = sum + blo(1, 6) / Tref
      End If
   End If
   fneq91 = sum
End Function

Public Function NR_Texhaust(guess As Double, goal As Double, alo As Range, ahi As Range)
   Dim A As Double
   Dim H1 As Double
   Dim cp As Double
   Dim diff As Double
   Dim slope As Double
   Dim intercept As Double
   Dim Ru As Double
   Dim Tref As Double
   Dim H0 As Double
   Dim err As Double
   Dim maxloops As Integer
   Dim i As Integer
   
   maxloops = 100
   err = 0.0001
   Ru = Range("k_RU").value
   Tref = 273.15 + Range("Tref").value
   
   H0 = fneq91(Tref, alo, ahi) * Ru * Tref
   cp = fneq90(guess, alo, ahi) * Ru
   H1 = fneq91(guess, alo, ahi) * Ru * guess - H0
   intercept = H1 - cp * guess
   diff = H1 - goal
   
   isdone = -1#
   i = 0
   While (isdone < 0)
      guess = (goal - intercept) / cp
      
      cp = fneq90(guess, alo, ahi) * Ru
      H1 = fneq91(guess, alo, ahi) * Ru * guess - H0
      intercept = H1 - cp * guess
      diff = H1 - goal
      
      If (Abs(diff) < err) Then isdone = 1
      i = i + 1
      If i >= maxloops Then isdone = 1
   Wend
   guess = (goal - intercept) / cp
   NR_Texhaust = guess

End Function








Public Function NR_XL(guess As Double, goal As Double)
   Dim A As Double
   Dim b As Double
   Dim C As Double
   Dim diff As Double
   Dim slope As Double
   Dim intercept As Double
   Dim err As Double
   Dim maxloops As Integer
   Dim i As Integer
   
   maxloops = 100
   err = 0.1
   
   A = 1.04 * guess ^ 2
   b = 2.05 * guess ^ 0.28
   C = A + b
   diff = C - goal
   slope = 2 * 1.04 * guess + 0.28 * 2.05 * guess ^ (0.28 - 1)
   
   isdone = -1#
   i = 0
   While (isdone < 0)
      guess = guess - diff / slope
      
      A = 1.04 * guess ^ 2
      b = 2.05 * guess ^ 0.28
      C = A + b
      diff = C - goal
      slope = 2 * 1.04 * guess + 0.28 * 2.05 * guess ^ (0.28 - 1)
      
      If (Abs(diff) < 0.1) Then isdone = 1
      i = i + 1
      If i >= maxloops Then isdone = 1
   Wend
   guess = guess - diff / slope
   NR_XL = guess

End Function


'ref: The International Association for the Properties of Water and Steam, 2007
'Revised Release on the IAPWS Industrial Formulation 1997 for the Thermodynamic Properties of Water and Steam
'Dimensionless saturation equations
Function p_sat(T As Double, gibbs As Range) As Double
   Dim sum As Double
   Dim ni As Double
   Dim agibbs As Variant
   Dim A As Double
   Dim b As Double
   Dim C As Double
   Dim V As Double
   
   agibbs = gibbs.value

   V = T + agibbs(9, 2) / (T - agibbs(10, 2))
   
   A = V * V + agibbs(1, 2) * V + agibbs(2, 2)
   b = agibbs(3, 2) * V * V + agibbs(4, 2) * V + agibbs(5, 2)
   C = agibbs(6, 2) * V * V + agibbs(7, 2) * V + agibbs(8, 2)
' Psat in MPa
   p_sat = 2# * C / (-b + Sqr(b * b - 4# * A * C))
   p_sat = p_sat * p_sat
   p_sat = p_sat * p_sat
   p_sat = p_sat * 1000# ' return kPa
End Function

'ref: The International Association for the Properties of Water and Steam, 2007
'Revised Release on the IAPWS Industrial Formulation 1997 for the Thermodynamic Properties of Water and Steam
'Dimensionless saturation equations
Function t_sat(P As Double, gibbs As Range) As Double
   Dim sum As Double
   Dim ni As Double
   Dim agibbs As Variant
   Dim d As Double
   Dim E As Double
   Dim F As Double
   Dim g As Double
   Dim b As Double
   
   agibbs = gibbs.value

' p in MPA
   b = (P * 0.001) ^ 0.25
   
   E = b * b + agibbs(3, 2) * b + agibbs(6, 2)
   F = agibbs(1, 2) * b * b + agibbs(4, 2) * b + agibbs(7, 2)
   g = agibbs(2, 2) * b * b + agibbs(5, 2) * b + agibbs(8, 2)
   
   d = 2# * g / (-F - Sqr(F * F - 4# * E * g))
' t_sat in K
   t_sat = agibbs(10, 2) + d - Sqr((agibbs(10, 2) + d) ^ 2# - 4# * (agibbs(9, 2) + agibbs(10, 2) * d))
   t_sat = t_sat * 0.5
End Function


' http://www.chem.mtu.edu/~tbco/cm3450/Compressibility_from_Redlich_Kwong.pdf
' Redlich-Kwong equation
' based on Cutlip and Shacham, 2008, pp. 101-103 (see Seader, Henley & Roper, 3rd Ed, 2011)
Function fnZ(T As Double, P As Double, Tc As Double, Pc As Double)
   Dim Tr As Double
   Dim Pr As Double
   Dim A As Double
   Dim b As Double
   Dim q As Double
   Dim R As Double
   
   Application.Volatile
   
   On Error GoTo error_handler
   Tr = T / Tc
   Pr = P / Pc
   
   A = 0.42747 * Pr / Tr ^ (5# / 2#)
   b = 0.08664 * Pr / Tr
   R = A * b
   q = b * b + b - A
   
   fnZ = mcroot(1, -1, -q, -R)
   Exit Function
   
error_handler:
   fnZ = "**ERROR**"
End Function


Function mcroot(a3 As Double, a2 As Double, a1 As Double, a0 As Double)
'
' Computes the maximum real root of the cubic equation
' a3 x^3 + a2 x^2 + a1 x + a0 = 0
'
Dim A As Double
Dim b As Double
Dim C As Double
Dim d As Double
Dim z As Double

   A = a2 / a3
   b = a1 / a3
   C = a0 / a3
   P = (-A ^ 2 / 3 + b) / 3
   q = (9 * A * b - 2 * A ^ 3 - 27 * C) / 54
   Disc = q ^ 2 + P ^ 3
   If Disc > 0 Then
      h = q + Disc ^ (1 / 2)
      y = (Abs(h)) ^ (1 / 3)
      If h < 0 Then y = -y
      z = y - P / y - A / 3
   Else
      theta = Atn((-Disc) ^ (1 / 2) / q)
      c1 = Cos(theta / 3)
      If q < 0 Then
         s1 = Sin(theta / 3)
         c1 = (c1 - s1 * 3 ^ (1 / 2)) / 2
      End If
      Z1 = 2 * (-P) ^ (1 / 2) * c1 - A / 3
      M = A + Z1
      R = (M ^ 2 - 4 * (b + M * Z1)) ^ (1 / 2)
      Z2 = (-M + R) / 2
      z3 = (-M - R) / 2
      z = Z1
      If Z2 > z Then z = Z2
      If z3 > z Then z = z3
   End If
   mcroot = z
End Function

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 = "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 = "Sheet11"
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 = "Sheet9"
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 = "Batch"
Option Base 1
'
' These routines handle batch processing
'
'
'
Dim err_batch As String

' 140625
' Batch processing for Meteorology
' scans the batch page for column 1 (irun flags)
' and loads and runs all flagged columns
'
Sub runbatchmet()
   Dim ir As Long
   Dim aa As Range
   
   err_batch = ""
   
   ir1 = Range("input_hdr").Row + 5
   
'   ir2 = Worksheets("iBATCH").UsedRange.Rows.Count
   ir2 = LastInColumn("iBATCH", 1)
   ir2 = Max(ir2 - 1, ir1)
   
   For ir = ir1 To ir2
      iRunFlag = Worksheets("iBATCH").Cells(ir, 1)
      If Abs(iRunFlag) > 0 Then
         Call run_row_met(ir)
         
         If Abs(iRunFlag) = 2 Then
            Call Print_Required
         End If
         If iRunFlag < 0 Then
            ActiveWorkbook.Save
         End If
         
      End If
   Next ir
   
   If err_batch <> "" And Range("mquiet") = 0 Then
      MsgBox "Error in Batch: " & err_batch, vbExclamation & vbOKOnly, AppName
   End If
   err_batch = ""

End Sub


' scans the batch page for column 1 (irun flags)
' and loads and runs all flagged columns
Sub runbatch()
   Dim ir As Long
   Dim aa As Range
   Dim fName As String
   
   oldmkeep = Range("mkeep")
   oldmkeepout = Range("mkeepout")
   If (Range("mexportout") = 1) And (oldmkeep <> 1 Or oldmkeepout <> 1) Then
      Range("mkeep") = 1
      Range("mkeepout") = 1
      If Range("mquiet") = 0 Then
         MsgBox "Because you selected mEXPORTOUT... " & vbCrLf & "mKEEP and mKEEPOUT are also selected", vbOKOnly, AppName & ":runbatch()"
      End If
   End If
   
   err_batch = ""
   ir1 = Range("input_hdr").Row + 5
   
'   ir2 = Worksheets("iBATCH").UsedRange.Rows.Count
   ir2 = LastInColumn("iBATCH", 1)
   ir2 = Max(ir2 - 1, ir1)
   
   For ir = ir1 To ir2
      iRunFlag = Worksheets("iBATCH").Cells(ir, 1)
      If Abs(iRunFlag) > 0 Then
      
         Call run_row(ir)
         
         If Abs(iRunFlag) = 2 Then
            Call Print_Required
         End If
         
         If iRunFlag < 0 Then
            ActiveWorkbook.Save
         End If
         
         If (Range("mpostbat") = 1) Then
            fName = Range("bin_postbat")
            If (Len(fName) > 1) Then
               sScenario = Range("flare_scenario")
               If InStr(1, sScenario, " ") > 0 Then
                  sScenario = Chr(34) & sScenario & Chr(34)
               End If
               RunWait Chr(34) & fName & Chr(34) & " " & ir & " " & sScenario
            End If
         End If
         
' check if there is output
' the MSCREEN_MOD output should be filled if there is output
         faermod = Range("MSCREEN_MOD")
         If (Not IsEmpty(faermod)) Then
' Export data
         If (Range("mexportout") = 1) Then
' if empty, then everything in the same folder, so use the scenario
' name to distinquish
            If (IsEmpty(faermod) Or faermod = "" Or faermod = "<temporary>") Then
               fPath = ".\"
               fbasename = Range("flare_scenario")
               faermod = fbasename
            Else
               ' if the entry is a path then assign the scenario name
               Dim sTest As String
               sTest = faermod
               If (FolderExists(sTest)) Then
                  Call FixFolderName(faermod)
               End If
' if a folder only specified, then likely there is a folder for each scenario
' so make all the filenames the same
               If (Len(Trim(faermod)) = 0 Or Right(faermod, 1) = "\") Then
                  faermod = faermod & sDefaultName  ' Range("flare_scenario")
               End If
            End If
            
            Set fs = CreateObject("Scripting.FileSystemObject")
            fPath = fs.GetParentFolderName(faermod)
            fbasename = fs.GetBaseName(faermod)

'           fPath = fs.GetParentFolderName(fileNameInZip.Path)
'           ListZipSingle = fs.GetExtensionName(fileNameInZip.Path)
'           ListZipSingle = fs.GetBaseName(fileNameInZip.Path)
'            ListZipSingle = fs.GetFilename(fileNameInZip.Path)

            Call FixFolderName(fPath)
            
            fName = fPath & fbasename & "_rbc_noadj.dat"
            Call Export_int("RBC_DUMP_INT", fName, , , True)
            fName = fPath & fbasename & "_limit2_noadj.dat"
            Call Export_int("LIM_DUMP_INT", fName, , , True)
            
            fName = fPath & fbasename & "_rbc.dat"
            Call ExportRBC_int_adjusted_m(fName, True)
            fName = fPath & fbasename & "_limit2.dat"
            Call ExportLIM_int_adjusted_m(fName, True)
         End If
         End If
         
      End If
   Next ir
   
   If err_batch <> "" And Range("mquiet") = 0 Then
      MsgBox "Error in Batch: " & err_batch, vbExclamation & vbOKOnly, AppName & ":runbatch()"
   End If
   err_batch = ""

   Range("mkeep") = oldmkeep
   Range("mkeepout") = oldmkeepout

End Sub

Sub loadcurrentrow()
   Dim irow As Long
   irow = ActiveCell.Row
   If (irow < Range("input_hdr") + 4) Then
      If Range("mquiet") = 0 Then
         MsgBox "Select a cell within the data range, below the titles", vbOKOnly + vbInformation, AppName
      End If
      Exit Sub
   End If
   Call Clear_All_Inputs
   
   load_row (irow)
   If err_batch <> "" And Range("mquiet") = 0 Then
      MsgBox "Error in Batch: " & err_batch, vbExclamation & vbOKOnly, AppName
   End If
   err_batch = ""
End Sub


Sub loadcurrentrow_met()
   Dim irow As Long
   irow = ActiveCell.Row
   If (irow < Range("input_hdr") + 4) Then
      If Range("mquiet") = 0 Then
         MsgBox "Select a cell within the data range, below the titles", vbOKOnly + vbInformation, AppName
      End If
      Exit Sub
   End If
   
   load_row_met (irow)
   
   If err_batch <> "" And Range("mquiet") = 0 Then
      MsgBox "Error in Batch: " & err_batch, vbExclamation & vbOKOnly, AppName
   End If
   err_batch = ""
End Sub



Sub loademptyrow()
   Dim irow As Long
   irow = 2
   load_row (irow)
   If err_batch <> "" And Range("mquiet") = 0 Then
      MsgBox "Error in Batch: " & err_batch, vbExclamation & vbOKOnly, AppName
   End If
   err_batch = ""
End Sub


Sub savetobatch()
   Dim inputs(300) As String
   Dim outputs(300) As String
   Dim indxcol(300) As Integer
   Dim ir2 As Long
   
   On Error GoTo error_handler
   err_batch = ""

   Call FreezeDisplay
   ir1 = Range("input_hdr").Row + 5
   
'   ir2 = 1 + Worksheets("iBATCH").UsedRange.Rows.Count
   ir2 = LastInColumn("iBATCH", 2)
   ir2 = Max(ir2, ir1)
   
' save inputs to IBATCH
   Call load_labels("iBatch", inputs, indxcol, "input")
      If Len(err_batch) > 0 Then GoTo error_handler
   Call save_out("iBatch", ir2, inputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler
   
   Rtn = vbYes
   If (Range("RECALC_REQD")) Then
      Rtn = MsgBox("The '***REMODEL***' flag has been raised. " & vbCrLf & _
                   "This indicates that modelling output does not match " & vbCrLf & _
                   "the inputs displayed." & vbCrLf & _
                   "Do you still want to copy the outputs to the batch page?", _
                   vbYesNo, AppName & ":SaveToBatch")
   End If
   If (Rtn = vbYes) Then
' save OUTPUTS to oBATCH
      Call load_labels("oBatch", outputs, indxcol, "output")
         If Len(err_batch) > 0 Then GoTo error_handler
      Call save_out("oBatch", ir2, outputs, indxcol)
         If Len(err_batch) > 0 Then GoTo error_handler
      
' save OUTPUTS to iBATCH
      Call load_labels("iBatch", outputs, indxcol, "output")
         If Len(err_batch) > 0 Then GoTo error_handler
      Call save_out("iBatch", ir2, outputs, indxcol)
         If Len(err_batch) > 0 Then GoTo error_handler
      If (Range("mquiet") = 0) Then
         Call MsgBox("Inputs and Outputs were saved to row:" & ir2 & " on iBATCH and oBATCH", vbOKOnly, AppName & ":SaveToBatch")
      End If
   Else
      If (Range("mquiet") = 0) Then
         Call MsgBox("Inputs only were saved to row:" & ir2 & " on iBATCH", vbOKOnly, AppName & ":SaveToBatch")
      End If
   End If
   
   Call ReDisplay
   Exit Sub
   
error_handler:
   If err_batch <> "" And Range("mquiet") = 0 Then
      MsgBox "Error in Batch: " & err_batch, vbExclamation & vbOKOnly, AppName
   End If
   err_batch = ""
   Call ReDisplay
End Sub

Sub load_row(irow As Long)
   Dim inputs(300) As String
   Dim outputs(300) As String
   Dim indxcol(300) As Integer
   
   On Error GoTo error_handler
   
   Call FreezeDisplay

   Call load_labels("iBatch", inputs, indxcol, "input")
      If Len(err_batch) > 0 Then GoTo error_handler
   Call load_in("iBatch", irow, inputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler
   
'   Call start_mtfa_change
'   Call start_flare_change
   Call start_mode_change
   
   Call ReDisplay
   Exit Sub
   
error_handler:
   Call start_mtfa_change
   Call start_flare_change
   If err_batch <> "" And Range("mquiet") = 0 Then
      MsgBox "Error in Batch: " & err_batch, vbExclamation & vbOKOnly, AppName
   End If
   err_batch = ""
   Call ReDisplay
   
End Sub



Sub load_row_met(irow As Long)
   Dim inputs(300) As String
   Dim outputs(300) As String
   Dim indxcol(300) As Integer
   
   On Error GoTo error_handler
   
   Call FreezeDisplay

iret = UnProtectSheets(GetPassWrd(), "iUSERMET")
   
   Call load_labels("iBatch", inputs, indxcol, "imet")
      If Len(err_batch) > 0 Then GoTo error_handler
   Call load_in("iBatch", irow, inputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler
   
   Call load_labels("oBatch", inputs, indxcol, "omet")
      If Len(err_batch) > 0 Then GoTo error_handler
   Call load_in("oBatch", irow, inputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler
   
iret = ProtectSheets(GetPassWrd(), "iUSERMET")
   
   Call ReDisplay
   Exit Sub
   
error_handler:
iret = ProtectSheets(GetPassWrd(), "iUSERMET")
   If err_batch <> "" And Range("mquiet") = 0 Then
      MsgBox "Error in Batch_met: " & err_batch, vbExclamation & vbOKOnly, AppName
   End If
   err_batch = ""
   Call ReDisplay
   
End Sub


' Load provided row from batch page
'
Sub run_row(irow As Long)
   Dim inputs(300) As String
   Dim outputs(300) As String
   Dim indxcol(300) As Integer
   Dim fmetfile As String
   Dim fterfile As String
   Dim faermod As String
   
   On Error GoTo error_handler
   
   Call FreezeDisplay
   
' Start fresh and erase everything
   Call Clear_All_Inputs
   
' Clear output on oBatch Page
   Call load_labels("oBATCH", outputs, indxcol, "output")
      If Len(err_batch) > 0 Then GoTo error_handler
   Call save_out("oBATCH", irow, outputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler

' Load all current inputs
   Call load_labels("iBATCH", inputs, indxcol, "input")
      If Len(err_batch) > 0 Then GoTo error_handler
   Call load_in("iBatch", irow, inputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler
   
' These get set automatically when the spreadsheet value changes
' reset all command switches to the the batch settings
'   Call start_mtfa_change
'   Call start_flare_change
   Call start_mode_change
   
   Call EmbossVersion
'   Call Recalc
'   Call RunAERMOD

'load output cells from iBATCH INPUTS page
   Call load_labels("iBATCH", outputs, indxcol, "output")
   ibutton = load_single("iBATCH", irow, outputs, indxcol, "MSCREEN_MODEL")
   fmetfile = load_single("iBATCH", irow, outputs, indxcol, "MSCREEN_MET")
   fterfile = load_single("iBATCH", irow, outputs, indxcol, "MSCREEN_TER")
   faermod = load_single("iBATCH", irow, outputs, indxcol, "MSCREEN_MOD")
   
' if empty, then everything in the same folder, so use the scenario
' name to distinquish
   If (IsEmpty(faermod) Or faermod = "" Or faermod = "<temporary>") Then
      fPath = ".\"
      fbasename = Range("flare_scenario")
      faermod = fbasename
   Else
      ' if the entry is a path then assign the scenario name
      Dim sTest As String
      sTest = faermod
      If (FolderExists(sTest)) Then
         Call FixFolderName(faermod)
      End If
' if a folder only specified, then likely there is a folder for each scenario
' so make all the filenames the same
      If (Len(Trim(faermod)) = 0 Or Right(faermod, 1) = "\") Then
         faermod = faermod & sDefaultName  ' Range("flare_scenario")
      End If
   End If
   
   Call autoclick(ibutton, fmetfile, fterfile, faermod)

' save outputs on oBATCH
   Call load_labels("oBATCH", outputs, indxcol, "output")
      If Len(err_batch) > 0 Then GoTo error_handler
   Call save_out("oBATCH", irow, outputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler
' save outputs on iBATCH
   Call load_labels("iBATCH", outputs, indxcol, "output")
      If Len(err_batch) > 0 Then GoTo error_handler
   Call save_out("iBATCH", irow, outputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler
   Call ReDisplay
   Exit Sub
   
error_handler:
   If err_batch <> "" And Range("mquiet") = 0 Then
      MsgBox "Error in Batch: " & err_batch, vbExclamation & vbOKOnly, AppName & ":run_row()"
   End If
   err_batch = ""
   Call ReDisplay
   
End Sub



Sub run_row_met(irow As Long)
   Dim inputs(300) As String
   Dim outputs(300) As String
   Dim indxcol(300) As Integer
   Dim fmetfile As String
   Dim fterfile As String
   Dim faermod As String
   Dim currentsheet As Object
   
   On Error GoTo error_handler
   
   Call FreezeDisplay
   
   err_batch = "initializing"
   
' Start fresh and erase everything
   Call ClearLCCdata
   
   err_batch = ""
   
' Clear oMET output on oBatch Page
iret = UnProtectSheets(GetPassWrd(), "iUSERMET")
   Call load_labels("oBATCH", outputs, indxcol, "omet")
      If Len(err_batch) > 0 Then GoTo error_handler
   Call save_out("oBATCH", irow, outputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler
iret = ProtectSheets(GetPassWrd(), "iUSERMET")

' Load all current inputs
   Call load_labels("iBATCH", inputs, indxcol, "input")
      If Len(err_batch) > 0 Then GoTo error_handler
   Call load_in("iBatch", irow, inputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler
   
' Load all current iMET inputs
   Call load_labels("iBATCH", inputs, indxcol, "imet")
      If Len(err_batch) > 0 Then GoTo error_handler
   Call load_in("iBatch", irow, inputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler
   
' These get set automatically when the spreadsheet value changes
' reset all command switches to the the batch settings
'   Call start_mtfa_change
'   Call start_flare_change
   Call start_mode_change
   
   Call EmbossVersion
'   Call Recalc
'   Call RunAERMOD

'load output cells from iBATCH INPUTS page
'   Call load_labels("iBATCH", outputs, indxcol, "output")
'   ibutton = load_single("iBATCH", irow, outputs, indxcol, "MSCREEN_MODEL")
'   fmetfile = load_single("iBATCH", irow, outputs, indxcol, "MSCREEN_MET")
'   fterfile = load_single("iBATCH", irow, outputs, indxcol, "MSCREEN_TER")
'   faermod = load_single("iBATCH", irow, outputs, indxcol, "MSCREEN_MOD")
   
' Run proper oMODELLING button here
'   Call autoclick(ibutton, fmetfile, fterfile, faermod)

' a path is required
   If (Range("user_screenmet") <> "") Then
      ' create LCC Output
      Set currentsheet = ActiveSheet
      Worksheets("iUSERMET").Activate
         Call refresh_mmeu
         Call GetLCCData
         Call CreateScreenMet
      currentsheet.Activate
   End If
   
' save outputs on oBATCH
   Call load_labels("oBATCH", outputs, indxcol, "omet")
      If Len(err_batch) > 0 Then GoTo error_handler
   Call save_out("oBATCH", irow, outputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler
      
' Force the save of the scenario name for this row
   For ic = 1 To UBound(indxcol)
      indxcol(ic) = -1
   Next ic
   indxcol(1) = 2
   outputs(1) = "flare_scenario"
   Call save_out("oBATCH", irow, outputs, indxcol)
      If Len(err_batch) > 0 Then GoTo error_handler
      
' save outputs on iBATCH
'   Call load_labels("iBATCH", outputs, indxcol, "output")
'      If Len(err_batch) > 0 Then GoTo error_handler
'   Call save_out("iBATCH", irow, outputs, indxcol)
'      If Len(err_batch) > 0 Then GoTo error_handler
   Call ReDisplay
   Exit Sub
   
error_handler:
   If err_batch <> "" And Range("mquiet") = 0 Then
      MsgBox "Error in Batch: " & err_batch, vbExclamation & vbOKOnly, AppName
   End If
   err_batch = ""
   Call ReDisplay
   
End Sub



' reads the flag on the hidden batch rows
' then copies the label for each column
Sub load_labels(sSheet As String, inputs() As String, indx() As Integer, flag As String)
   Dim ir1 As Integer
   ir1 = Range("input_hdr").Row
   ic1 = 2
'   ic2 = Worksheets(sSheet).UsedRange.Columns.count
   ic2 = LastInRow(sSheet, ir1)
   
   On Error GoTo error_handler
   
' reset index
   For ic = 1 To UBound(indx)
      indx(ic) = -1
   Next ic
' load labels
   With Worksheets(sSheet)
   ix = 0
   For ic = ic1 To ic2
      If .Cells(ir1, ic).value = flag And ix < UBound(indx) Then
         ix = ix + 1
         inputs(ix) = .Cells(ir1 + 1, ic).value
         indx(ix) = ic
      End If
   Next ic
   End With
   Exit Sub
error_handler:
   err_batch = "load_labels"
End Sub

' reads the row=irow from batch page
Sub load_in(sSheet As String, irow As Long, inputs() As String, indxcol() As Integer)
   
   On Error GoTo error_handler
   iret = FreezeDisplay(False)
'   With Worksheets("iBATCH")
   ic2 = UBound(indxcol)
   For ic = 1 To ic2
'      If (LCase(inputs(ic)) = "mblowdown") Then
'         zzz = 1
'      End If
      If indxcol(ic) > 0 Then
         ix = indxcol(ic)
…

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