Malicious Office (OOXML) — malware analysis report

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_BeforeClose(Cancel As Boolean)
    '
    '****************************************************************************************
    '       Title       Workbook_BeforeClose
    '       Author:     Jesse Simpson
    '       Function:   Make sure to kill the Cadstar Advisor and set the cross-probe user
    '                     settings for the next time we start Excel.
    '       Limitation: NONE
    '
    '****************************************************************************************
    '
    On Error Resume Next
    Dim Cadstar As New clsCadstar
    Cadstar.KillAdvisor CadstarAdvisorNumber
    CrossProbeClear
End Sub

Private Sub Workbook_Open()
    '
    '****************************************************************************************
    '       Title       Workbook_Open
    '       Author:     Jesse Simpson
    '       Function:   Allow for application-level event handling
    '       Limitation: NONE
    '
    '****************************************************************************************
    '
    RefreshApp
    ReportVersion
    Application.OnTime Now, "RefreshFindPartJAR"                            ' download the latest FindPart JAR
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 = "clsCSOutput"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit
'
'****************************************************************************************
'       Class:          clsCSOutput
'       Author:         Jesse Simpson
'       Description:    Container object for the Cadstar Output worksheet in a BOMBOM workbook
'
'****************************************************************************************
'

Private m_Worksheet As Worksheet    ' the worksheet bounded by this object
Private m_ReportVersion As String   ' the Version of BOMBOM.rgf used to create this output
Private m_ReportDate As String      ' the date/time on which this BOMBOM report was generated
Private m_SchematicPath As String   ' the system path of the source schematic
Private m_Schematic As String       ' the GPN (string) of the source schematic
Private m_PCB As String             ' the GPN (string) of the source PCB
Private m_PCBAssembly As String     ' the GPN (string) of the source PCB assembly
Private m_Settings As String        ' the settings string to be input or output
Private m_StartRow As Integer       ' the first row of actual data in the worksheet
Private m_LastRow As Integer        ' the last row of data in the worksheet
Private m_Columns As Collection     ' associative collection of columns output by BOMBOM.rgf
Private m_Items As Collection       ' collection of items (clsCSOutputItem) in this workbook
Private m_PreLoad As Boolean        ' indicate if settings data has been pre-loaded at startup

Public Sub Init(ByVal Sheet As Worksheet)
    Dim x As Range
    Set m_Worksheet = Sheet
    m_PreLoad = False
    With m_Worksheet
        m_ReportVersion = .Range("A1").Value
        m_ReportDate = VBA.DateValue(.Range("B2").Value & ", " & .Range("C2").Value) + .Range("A3").Value
        'm_SchematicPath = .Range("A4").Value
        Regex.GlobalExecute = True
        m_SchematicPath = Regex.Replace("", "[\r\n]", .Range("A4").Value)
        getSchematicNumbers
        m_Settings = .Range("A5").Value
        parseSettings
        Set x = .Range("A:A").Find("[**START_DATA**]")
        If .Range("A:A").Find("[**START_DATA**]") Is Nothing Then
            m_StartRow = 9
        Else
            m_StartRow = x.Offset(1, 0).Row
        End If
        m_LastRow = .UsedRange.Rows.Count
    End With
    Set m_Columns = New Collection
    With m_Columns
        .Add "A", "RefDes"
        .Add "B", "GPN"
        .Add "C", "Not_Used"
        .Add "D", "Position_Indicator"
        .Add "E", "BOM"
        .Add "F", "BOM_partnumber"
        .Add "G", "BOM_groupselect"
        .Add "H", "BOM_select"
        .Add "I", "BOM_comment"
        .Add "J", "Reduced_BOM"
        .Add "K", "BOM_modelselect"
        .Add "L", "BOM_boardrev"
        .Add "M", "BOM_priority"
    End With
    Set m_Items = New Collection
End Sub

Public Property Get StartRow() As Integer
    StartRow = m_StartRow
End Property
Public Property Get LastRow() As Integer
    LastRow = m_LastRow
End Property
Public Property Get Worksheet() As Worksheet
    Set Worksheet = m_Worksheet
End Property
Public Property Get BOMBOMColumns() As Collection
    Set BOMBOMColumns = m_Columns
End Property
Public Property Get Schematic() As String
    Schematic = m_Schematic
End Property
Public Property Let Schematic(ByVal sSchematic As String)
    m_Schematic = sSchematic
End Property
Public Property Get PCB() As String
    PCB = m_PCB
End Property
Public Property Let PCB(ByVal sPCB As String)
    m_PCB = sPCB
End Property
Public Property Get PCBAssembly() As String
    PCBAssembly = m_PCBAssembly
End Property
Public Property Let PCBAssembly(ByVal sAssy As String)
    m_PCBAssembly = sAssy
End Property
Public Property Get items() As Collection
    Set items = m_Items
End Property
Public Property Get SchematicPath() As String
    SchematicPath = m_SchematicPath
End Property
Public Property Get Preloaded() As Boolean
    Preloaded = m_PreLoad
End Property

Private Sub getSchematicNumbers()
    '
    '****************************************************************************************
    '       Title:      getSchematicNumbers
    '       Author:     Jesse Simpson
    '       Function:   Get the Schematic, PCB and PCB assembly part numbers from the schematic
    '                     path if possible
    '       Limitation: NONE
    '
    '****************************************************************************************
    '
    Dim matches As Object
    
    If Regex.test(GPN_SET, m_SchematicPath) Then
        Set matches = Regex.Execute
        m_Schematic = matches(0)
        m_PCB = "105-" & matches(0).submatches(1) & "-" & matches(0).submatches(2)
        m_PCBAssembly = "016-" & matches(0).submatches(1) & "-" & matches(0).submatches(2)
    Else
        m_Schematic = "014-XXXXX-XX"
        m_PCB = "105-XXXXX-XX"
        m_PCBAssembly = "016-XXXXX-XX"
    End If
End Sub
Public Sub LoadSettings(ByVal SettingsString As String)
    '
    '****************************************************************************************
    '       Title:      LoadSettings
    '       Author:     Jesse Simpson
    '       Function:   Load system settings from the provided text data
    '       Limitation: NONE
    '       Parameters:
    '           SettingsString  [input, String] The settings data to be loaded
    '
    '****************************************************************************************
    '
    BB.ClearSettings
    m_Settings = SettingsString
    parseSettings
End Sub
Private Sub parseSettings()
    '
    '****************************************************************************************
    '       Title:      parseSettings
    '       Author:     Jesse Simpson
    '       Function:   Parse the contents of the "m_Settings" variable to load data from it
    '       Limitation: NONE
    '
    '****************************************************************************************
    '
    Dim matches As Object
    Dim next_matches As Object
    Dim match As Object
    Dim next_match As Object
    Dim Comment As String
    Dim UOM As String
    Dim Quantity As Integer
    Dim Item As clsUploadBOMItem
    Dim Inclusions As String
    Dim RefDes As String
    Dim Bub As String
    
    ' check the BOMBOM.rgf info for the loaded settings
    Regex.Reset
    Regex.GlobalExecute = False
    If Regex.test("\[BOM_CREATOR\][\r\n]+?(.*?)[\r\n]+?(.*?)[\r\n]+?(.*?)[\r\n]+?\[/BOM_CREATOR\]", m_Settings) Then
        Set matches = Regex.Execute
        If StrComp("Version " & matches(0).submatches(0), m_ReportVersion) < 0 Then
            ' the settings we're parsing were generated by an older version
            If System.Alert(True, "The settings data is outdated.  Do you wish to continue?", "Old Settings", vbYesNo + vbQuestion) = vbNo Then Exit Sub
        End If
        ' at this point, we know we have valid settings data - trigger the preload variable
        m_PreLoad = True
    End If
    'BOM tree and included documents
    Regex.Reset
    If Regex.test("^BOM Tree\\(?:.*?)(?:(" & GPN_SET & ")\\)?(" & GPN_SET & ")$", m_Settings) Then
        'we found BOM tree information - continue onward
        Set matches = Regex.Execute
        For Each match In matches
            'new item to add
            BB.AddUploadBOM match.submatches(4)
            'check if it has a parent
            If match.submatches(0) <> "" Then
                'parent should already be present - just add the relationships
                BB.UploadBOMs(match.submatches(0)).AddChild BB.UploadBOMs(match.submatches(4))
                BB.UploadBOMs(match.submatches(4)).Parent = BB.UploadBOMs(match.submatches(0))
            End If
            
            'now look for any default data that needs to be populated into the BOM
            Regex.GlobalExecute = False
            If Regex.test("\[" & match.submatches(4) & "\][\r\n]+?([\s\S]*?)\[/" & match.submatches(4) & "\]", m_Settings) Then
                Set next_matches = Regex.Execute
                Inclusions = next_matches(0).submatches(0)
                Regex.GlobalExecute = True
                If Regex.test("^(" & GPN_SET & ")(;([^;]*);([^;]*);(([^\r\n;]*)|([^;]*);([^;]*);([^\r\n;]*)))?[\r\n]+?", Inclusions) Then
                    'found items in the included documents section for this BOM
                    ' there are three possible formats for includes:
                    '  1st-gen) GPN
                    '  2nd-gen) GPN;Comment;Qty;UOM
                    '  3rd-gen) GPN;Comment;Qty;UOM;RefDes;Bub
                    Set next_matches = Regex.Execute
                    For Each next_match In next_matches
                        RefDes = ""
                        Bub = ""
                        ' first update comment and quantity based on "common includes"
                        If next_match.submatches(4) = "" Then       ' 1st-gen format, assumes Qty=1, UOM=EA, Comment="", unless it's a SCM/ASSY/REF document
                            If Regex.test("^014-|^016-|^001-", next_match.submatches(0)) Then
                                Comment = "REFERENCE DOCUMENT"
                                Quantity = 0
                                UOM = "EA"
                            Else
                                Comment = ""
                                Quantity = 1
                                UOM = "EA"
                            End If
                        ElseIf InStr(next_match.submatches(7), ";") > 0 Then   ' 3rd-gen format, no assumptions, all fields provided
                            Comment = next_match.submatches(5)
                            Quantity = next_match.submatches(6)
                            UOM = next_match.submatches(9)
                            RefDes = next_match.submatches(10)
                            Bub = next_match.submatches(11)
                        Else                                                    ' 2nd-gen format, assumes UOM=EA if not provided
                            Comment = next_match.submatches(5)
                            Quantity = next_match.submatches(6)
                            UOM = UCase(next_match.submatches(8))
                            If Trim(UOM) = "" Then UOM = "EA"
                        End If
                        ' now update scm/pcb/assy part numbers if they are provided
                        If Regex.test("^014-", next_match.submatches(0)) Then
                            BB.CSOut.Schematic = next_match.submatches(0)
                        ElseIf Regex.test("^016-", next_match.submatches(0)) Then
                            BB.CSOut.PCBAssembly = next_match.submatches(0)
                        ElseIf Regex.test("^105-", next_match.submatches(0)) Then
                            BB.CSOut.PCB = next_match.submatches(0)
                        End If
                        ' move on
                        Set Item = New clsUploadBOMItem
                        Item.Init RefDes, next_match.submatches(0), Comment, Quantity, "", UOM, Bub
                        BB.UploadBOMs(match.submatches(4)).Include Item
                    Next
                End If
            End If
        Next
    End If
    
    'Default BOM
    Regex.Reset
    Regex.GlobalExecute = False
    If Regex.test("\[DEFAULT_BOM\][\r\n]+?([\s\S]*?)[\r\n]+?\[/DEFAULT_BOM\]", m_Settings) Then
        Set matches = Regex.Execute
        Inclusions = matches(0).submatches(0)
        Regex.GlobalExecute = True
        If Regex.test("(" & GPN_SET & ")(?:;|$)", Inclusions) Then
            Set matches = Regex.Execute
            For Each match In matches
                BB.AddDefaultBOM match.submatches(0)
            Next
        End If
    End If
    
    'Group Select
    Regex.Reset
    Regex.GlobalExecute = False
    If Regex.test("\[GROUP_SELECT\][\r\n]+?([\s\S]*?)[\r\n]+?\[/GROUP_SELECT\]", m_Settings) Then
        Set matches = Regex.Execute
        Inclusions = matches(0).submatches(0)
        Regex.GlobalExecute = True
        If Regex.test("^([^\r\n:]*?):([^:]*?)(?::([^:\r\n]*?))?$", Inclusions) Then
            Set matches = Regex.Execute
            For Each match In matches
                BB.AddGroupSelect match.submatches(0), CInt(match.submatches(1)), CBool(match.submatches(2))
            Next
        End If
    End If
    
    'Model Select
    Regex.Reset
    Regex.GlobalExecute = False
    If Regex.test("\[MODEL_SELECT\][\r\n]+?([\s\S]*?)[\r\n]+?\[/MODEL_SELECT\]", m_Settings) Then
        Set matches = Regex.Execute
        Inclusions = matches(0).submatches(0)
        Regex.GlobalExecute = True
        If Regex.test("^(" & GPN_SET & "):(\d*?)$", Inclusions) Then
            Set matches = Regex.Execute
            For Each match In matches
                BB.UploadBOMs(match.submatches(0)).ModelSelect.Value = CInt(match.submatches(4))
            Next
        End If
    End If
    
    'Board Revision
    Regex.Reset
    Regex.GlobalExecute = False
    If Regex.test("\[BOARD_REV\][\r\n]+?([\s\S]*?)[\r\n]+?\[/BOARD_REV\]", m_Settings) Then
        Set matches = Regex.Execute
        Inclusions = matches(0).submatches(0)
        Regex.GlobalExecute = True
        If Regex.test("^(" & GPN_SET & "):(\d*?)$", Inclusions) Then
            Set matches = Regex.Execute
            For Each match In matches
                BB.UploadBOMs(match.submatches(0)).BoardRev.Value = CInt(match.submatches(4))
            Next
        End If
    End If
    
    'Stock Location
    Regex.Reset
    Regex.GlobalExecute = False
    If Regex.test("\[PULL_STOCK\][\r\n]+?(.*?)[\r\n]+?\[/PULL_STOCK\]", m_Settings) Then
        Regex.GlobalExecute = True
        Set matches = Regex.Execute
        BB.stockLocation = matches(0).submatches(0)
    End If
    
    'Taiwan Forecast
    Regex.Reset
    Regex.GlobalExecute = False
    If Regex.test("\[FORECAST\][\r\n]+?(.*?)[\r\n]+?\[/FORECAST\]", m_Settings) Then
        Regex.GlobalExecute = True
        Set matches = Regex.Execute
        BB.IncludeForecast = CBool(matches(0).submatches(0))
    End If
    
    'Reduced BOM
    Regex.Reset
    Regex.GlobalExecute = False
    If Regex.test("\[DO_REDUCTION\][\r\n]+?(.*?)[\r\n]+?\[/DO_REDUCTION\]", m_Settings) Then
        Regex.GlobalExecute = True
        Set matches = Regex.Execute
        BB.DoReduction = CBool(matches(0).submatches(0))
    End If
End Sub
Public Function DumpSettings() As String
    '
    '****************************************************************************************
    '       Title:      DumpSettings
    '       Author:     Jesse Simpson
    '       Function:   Output the current settings into the XML-type string used for saving
    '                     to cell A5 in a Cadstar Output page or to a text file or CSA
    '       Limitation: NONE
    '
    '****************************************************************************************
    '
    Dim s As String
    Dim b As clsUploadBOM
    Dim i As clsUploadBOMItem
    Dim v As Variant
    Dim g As clsGroupSelect
    ' first output the report information
    s = "[BOM_CREATOR]" & vbCrLf & _
        m_ReportVersion & vbCrLf & _
        FormatDateTime(m_ReportDate, vbShortDate) & vbCrLf & _
        FormatDateTime(m_ReportDate, vbLongTime) & vbCrLf & _
        "[/BOM_CREATOR]" & vbCrLf
    ' now output the BOM tree
    s = s & "[BOM_TREE]" & vbCrLf & "BOM Tree" & vbCrLf
    For Each b In BB.UploadBOMs
        s = s & "BOM Tree\" & b.path & vbCrLf
    Next b
    s = s & "[/BOM_TREE]" & vbCrLf
    ' bom includes
    For Each b In BB.UploadBOMs
        s = s & "[" & b.GPN & "]" & vbCrLf
        For Each i In b.IncludedItems
            s = s & i.GPN & ";" & i.Comment & ";" & i.Quantity & ";" & i.UOM & ";" & i.RefDes.RefDes & ";" & i.Bub & vbCrLf
        Next i
        s = s & "[/" & b.GPN & "]" & vbCrLf
    Next b
    ' default BOM
    s = s & "[DEFAULT_BOM]" & vbCrLf
    For Each v In BB.defaultBOM
        s = s & v & ";"
    Next v
    s = Left(s, Len(s) - 1) & vbCrLf & "[/DEFAULT_BOM]" & vbCrLf
    ' group select
    s = s & "[GROUP_SELECT]" & vbCrLf
    For Each g In BB.GroupSelects
        If g.Chosen Then
            s = s & g.GroupName & ":" & g.SelectedIndex & ":" & g.Legacy & vbCrLf
        End If
    Next g
    s = s & "[/GROUP_SELECT]" & vbCrLf
    ' model select
    s = s & "[MODEL_SELECT]" & vbCrLf
    For Each b In BB.UploadBOMs
        If b.ModelSelect.Chosen Then
            s = s & b.GPN & ":" & b.ModelSelect.Value & vbCrLf
        End If
    Next b
    s = s & "[/MODEL_SELECT]" & vbCrLf
    ' board revision
    s = s & "[BOARD_REV]" & vbCrLf
    For Each b In BB.UploadBOMs
        If b.BoardRev.Chosen Then
            s = s & b.GPN & ":" & b.BoardRev.Value & vbCrLf
        End If
    Next b
    s = s & "[/BOARD_REV]" & vbCrLf
    ' stock location
    s = s & "[PULL_STOCK]" & vbCrLf & _
            BB.stockLocation & vbCrLf & _
            "[/PULL_STOCK]" & vbCrLf
    ' forecast
    s = s & "[FORECAST]" & vbCrLf & _
            BB.IncludeForecast & vbCrLf & _
            "[/FORECAST]" & vbCrLf
    ' reduced bom
    s = s & "[DO_REDUCTION]" & vbCrLf & _
            BB.DoReduction & vbCrLf & _
            "[/DO_REDUCTION]"
            
    DumpSettings = s
End Function
Public Sub AddItem(ByVal Item As clsCSOutputItem)
    '
    '****************************************************************************************
    '       Title:      AddItem
    '       Author:     Jesse Simpson
    '       Function:   Add a clsCSOutputItem object to the collection.  Also, if it has
    '                     user-input-required BOMBOM attributes, add it to the container
    '                     collections to trigger required action later on
    '       Limitation: NONE
    '       Parameters:
    '           Item    [input, clsCSOutputItem]    The item to add
    '
    '****************************************************************************************
    '
    Dim matches As Object
    Dim options As Variant
    Dim GSItem As New clsGroupSelectItem
    Dim opts As Object
    Dim GSName As String
    
    ' add the item to the collection
    If Not inCollection(m_Items, Item.RefDes.RefDes) Then m_Items.Add Item, Item.RefDes.RefDes
    
    ' check the BOMBOM attributes to see if we need to add this item to clsContainer GroupSelect collection
    Regex.Reset
    With Item.BOMBOM
        If .BOM_groupselect <> "" Then
            If Regex.test("^([^\[]+)\[([^\]]+)\]", .BOM_groupselect) Then
                Set matches = Regex.Execute
                If Regex.test("\<\:\>", matches(0).submatches(0)) Then
                    Set opts = Regex.Execute
                    'matches(0).submatches(0) = Trim(Replace(matches(0).submatches(0), opts(0), ""))
                    GSName = Trim(Replace(matches(0).submatches(0), opts(0), ""))
                    BB.AddGroupSelect GSName
                    BB.GroupSelects(GSName).Legacy = True
                Else
                    GSName = Trim(matches(0).submatches(0))
                    BB.AddGroupSelect GSName
                End If
                ' now that we know the Group Select is available for use, populate the item
                'options = Split(UCase(Replace(matches(0).submatches(1), " ", "")), ":")
                options = Split(matches(0).submatches(1), ":")
                Dim i As Integer
                For i = 0 To UBound(options)
                    If Regex.test("\<\?(.+?)\>", options(i)) Then
                        ' this option has a specified name
                        Set opts = Regex.Execute
                        If BB.GroupSelects(GSName).SetOptionName(i, Trim(opts(0).submatches(0))) = False Then
                            ' there was an error setting the name...what do we do here???
                            BB.RaiseWarning "clsCSOutput.AddItem", "Group Select """ & GSName & """ Option " & (i + 1) & " has a name of """ & Trim(opts(0).submatches(0)) & """ applied by " & Item.RefDes.RefDes & ".  This option name is not consistent with a previously set name.  Please ensure that any item in Group Select """ & GSName & """ which sets option names is consistent or your BOMBOM Forms Group Select option list may display unexpected results."
                        End If
                        options(i) = Replace(options(i), opts(0), "")
                    End If
                    If Regex.test("\<\*\>", options(i)) Then
                        ' this option has been specified as the default
                        Set opts = Regex.Execute
                        If BB.GroupSelects(GSName).SetSelectedIndex(i) = False Then
                            ' throw a warning about the index setting
                            BB.RaiseWarning "clsCSOutput.AddItem", "Group Select """ & GSName & """ Option " & (i + 1) & " is set as the default choice by " & Item.RefDes.RefDes & ".  This is inconsistent with the choice either loaded by the BOMBOM Settings or made by a previous item.  Please ensure that any item in Group Select """ & GSName & """ which sets the default choice is consistent with other options and with BOMBOM settings to ensure the most accurate output."
                        End If
                        options(i) = Replace(options(i), opts(0), "")
                    End If
                    'options(i) = UCase(Replace(options(i), " ", ""))
                    options(i) = UCase(Regex.Replace("", "[\s\r\n]", options(i)))
                Next i
                GSItem.Init Item.RefDes, Item.GPN, options
                BB.GroupSelects(GSName).AddItem GSItem
            End If
        End If
    End With
End Sub


Attribute VB_Name = "clsUploadBOM"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit
'
'****************************************************************************************
'       Class:          clsUploadBOM
'       Author:         Jesse Simpson
'       Description:    Container object for Upload BOM worksheets
'                        ** ALSO, container object for "Reduced BOM" worksheets
'                           Only real difference of a Reduced BOM is the "Comment" field
'                           is swapped out for the "Failure Condition" field and extra
'                           processing determins what goes into this field
'
'****************************************************************************************
'

Private m_GPN As String             ' the GPN of the UploadBOM worksheet
Private m_Revision As String        ' the current released revision of this BOM
Private m_Designator As String      ' the designator by which this BOM is referenced in the schematic (BOMGEN)
Private m_Author As String          ' the current system user (used for "Drawn By & Date")
Private m_Items As Collection       ' collection of items to appear on the BOM (clsUploadBOMItem)
Private m_Includes As Collection    ' collection of included items that appear on the BOM (clsUploadBOMItem)
Private m_Reduced As Boolean        ' if true, we will do a BOM reduction on this BOM
Private m_Children As Collection    ' collection of clsUploadBOM objects that inherit this BOM
Private m_Parent As clsUploadBOM    ' the parent item of this BOM if it exists
Private m_ModelSelect As clsModelSelect     ' The Model Select object for this BOM
Private m_BoardRev As clsBoardRevision      ' The Board Revision object for this BOM
Private m_Stock As Collection

Public Sub Init(ByVal GPN As String, Optional ByVal ReducedBOM As Boolean = False)
    m_GPN = GPN
    m_Revision = ""
    m_Reduced = ReducedBOM
    Set m_Children = New Collection
    Set m_Items = New Collection
    Set m_Includes = New Collection
    Set m_ModelSelect = New clsModelSelect
    Set m_Stock = New Collection
    m_ModelSelect.Init
    Set m_BoardRev = New clsBoardRevision
    m_BoardRev.Init
End Sub

Public Property Get GPN() As String
    GPN = m_GPN
End Property
Public Property Get Revision() As String
    Revision = m_Revision
End Property
Public Property Let Revision(ByVal sRevision As String)
    m_Revision = sRevision
End Property
Public Property Get Designator() As String
    Designator = m_Designator
End Property
Public Property Let Designator(ByVal sDes As String)
    m_Designator = sDes
End Property

Public Property Get NextRevision() As String
    ' technically this is a function, but I want NextRevision to be visible, externally, as a property
    Dim x As Integer
    'first handle the "initial release" case
    If m_Revision = "0" Or m_Revision = "" Then
        NextRevision = "1"
    ElseIf IsNumeric(m_Revision) Then
        NextRevision = CStr(CInt(m_Revision) + 1)
    Else
        x = VBA.Asc(VBA.Right$(m_Revision, 1))
        If x = 90 Then 'we're at ("Z") the end of the alphabet
            If VBA.Len(m_Revision) = 1 Then
                ' after "Z" comes "AA"
                NextRevision = "AA"
            ElseIf VBA.Left$(m_Revision, 1) = "Z" Then
                ' we're at "ZZ" - no available next revision, so set to blank
                NextRevision = ""
            Else
                ' increment the left digit and reset the right to "A"
                NextRevision = VBA.Chr$(VBA.Asc(VBA.Left$(m_Revision, 1)) + 1) & "A"
            End If
        Else
            ' keep the left digit and increment the right digit
            NextRevision = VBA.Left$(m_Revision, VBA.Len(m_Revision) - 1) & VBA.Chr$(x + 1)
        End If
    End If
End Property
Public Property Get Reduced() As Boolean
    Reduced = m_Reduced
End Property
Public Property Get Children() As Collection
    Set Children = m_Children
End Property
Public Property Get Parent() As clsUploadBOM
    Set Parent = m_Parent
End Property
Public Property Let Parent(ByRef oParent As clsUploadBOM)
    If oParent Is Nothing Then
        Set m_Parent = Nothing
        Exit Property
    End If
    Set m_Parent = oParent
    Dim i As New clsUploadBOMItem
    i.Init "", oParent.GPN, "", 1
    Me.Include i, True
End Property
Public Property Get IncludedItems() As Collection
    Set IncludedItems = m_Includes
End Property
Public Property Get ModelSelect() As clsModelSelect
    Set ModelSelect = m_ModelSelect
End Property
Public Property Get BoardRev() As clsBoardRevision
    Set BoardRev = m_BoardRev
End Property
Public Property Get items() As Collection
    Set items = m_Items
End Property
Public Property Get Stock() As Collection
    Set Stock = m_Stock
End Property

Public Sub AddChild(ByRef BOM As clsUploadBOM)
    '
    '****************************************************************************************
    '       Title:      AddChild
    '       Author:     Jesse Simpson
    '       Function:   Add a Child object (clsUploadBOM) to the collection
    '       Limitation: NONE
    '       Parameters:
    '           BOM     [input, clsUploadBOM*]   The clsUploadBOM object to add to the child collection (pointer)
    '
    '****************************************************************************************
    '
    If Not inCollection(m_Children, BOM.GPN) Then m_Children.Add BOM, BOM.GPN
    ' since this BOM now has a child, it is not recommended to use the Model Select attribute
    m_ModelSelect.Recommended = False
    ' children BOMs are also BOM's themselves, so we do not add them to the stock collection here
End Sub
Public Sub Include(ByVal Item As clsUploadBOMItem, Optional ByVal NoStock As Boolean = False)
    '
    '****************************************************************************************
    '       Title:      Include
    '       Author:     Jesse Simpson
    '       Function:   Add an "included" item to the UploadBOM (clsUploadBOMItem)
    '       Limitation: NONE
    '       Parameters:
    '           Item    [input, clsUploadBOMItem]   The clsUploadBOMItem object to add to the Includes collection
    '
    '****************************************************************************************
    '
    If Not inCollection(m_Includes, Item.GPN) Then m_Includes.Add Item, Item.GPN
    ' if this BOM includes a PCB, we recommend the use of the Board Rev attribute
    If Left(Item.GPN, 4) = "105-" Then m_BoardRev.Recommended = True
    ' add the part number to the stock collection to keep an accurate count (only if we are instructed to)
    If Not NoStock Then IncrementStock Item.GPN, Item.Quantity
End Sub
Public Sub AddItem(ByVal Item As clsUploadBOMItem)
    '
    '****************************************************************************************
    '       Title:      AddItem
    '       Author:     Jesse Simpson
    '       Function:   Add an item (clsUploadBOMItem) to the BOM
    '       Limitation: NONE
    '       Parameters:
    '           Item    [input, clsUploadBOMItem]   The clsUploadBOMItem object to add to the Items collection
    '
    '****************************************************************************************
    '
    'If Not inCollection(m_Items, Item.RefDes.RefDes) Then m_Items.Add Item, Item.RefDes.RefDes
    m_Items.Add Item
    'If Not inCollection(m_Items, Item.RefDes) Then m_Items.Add Item, Item.RefDes
    ' add the part number to the stock collection to keep an accurate count
    IncrementStock Item.GPN, Item.Quantity
End Sub
Private Sub IncrementStock(ByVal GPN As String, ByVal qty As Integer)
    '
    '****************************************************************************************
    '       Title:      IncrementStock
    '       Author:     Jesse Simpson
    '       Function:   Increment the quantity of the given part number used on this BOM
    '       Limitation: NONE
    '       Parameters:
    '           GPN     [input, String]     The GPN we're adding to the BOM
    '           QTY     [input, Integer]    The quantity used in this instance
    '
    '****************************************************************************************
    '
    Dim t As Integer
    Dim i As clsStockItem
    If inCollection(m_Stock, GPN) Then
        m_Stock(GPN).Increment qty
    Else
        Set i = New clsStockItem
        i.Init GPN, qty
        m_Stock.Add i, GPN
    End If
End Sub
Public Function IsMatch(ByVal bomstr As String) As Boolean
    '
    '****************************************************************************************
    '       Title:      IsMatch
    '       Author:     Jesse Simpson
    '       Function:   Take a BOMBOM "BOM" string and determine if this BOM is called out in it
    '       Limitation: NONE
    '       Parameters:
    '           bomstr  [input, String]     The BOMBOM "BOM" attribute string
    '       Return:
    '           True if this BOM is called out in the string; false otherwise
    '
    '****************************************************************************************
    '
    Dim groups As Object
    Dim subset As Object
    Regex.Reset
    IsMatch = False
    If bomstr = "" Then Exit Function
    Set groups = Regex.Execute("(?:^|;|\s)((?:([0-9A-HJ-NP-WY-Z]{3})-([0-9A-HJ-NP-Z]{5}))?-([0-9A-HJ-NP-Z]{2}))(?:$|\b)", bomstr)
    For Each subset In groups
        If Regex.test(Replace(Trim(subset.submatches(0)), "X", "[0-9A-HJ-NP-WY-Z]") & "$", m_GPN) Then
            IsMatch = True
            Exit Function
        End If
    Next
End Function
Public Function path(Optional ByVal Separator As String = "\") As String
    '
    '****************************************************************************************
    '       Title:      Path
    '       Author:     Jesse Simpson
    '       Function:   Get the full path of this BOM (parent\parent\...\this BOM)
    '       Limitation: NONE
    '       Parameters:
    '           Separator  [input, String, Optional]     The separator between BOMs (default = "\")
    '       Return:
    '           The path string
    '
    '****************************************************************************************
    '
    Dim s As String
    Dim b As clsUploadBOM
    
    s = m_GPN
    Set b = Me
    While Not b.Parent Is Nothing
        s = b.Parent.GPN & Separator & s
        Set b = b.Parent
    Wend
    
    path = s
End Function


Attribute VB_Name = "clsGPN"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit
'
'****************************************************************************************
'       Class:          clsGPN
'       Author:         Jesse Simpson
'       Description:    Container object for all part numbers in the workbook
'
'****************************************************************************************
'

Private m_GPN As String             ' the GPN string
Private m_Description As String     ' the rest of the attributes are populated by FindPart data...
Private m_Revision As String
Private m_TaiwanStock As Long
Private m_TaiwanCost As Single
Private m_OlatheStock As Long
Private m_OlatheCost As Single
Private m_SalemStock As Long
Private m_SalemCost As Single
Private m_Comment As String
Private m_Forecast As Long
Private m_PrimaryUOM As String

Public Sub Init(ByVal GPN As String)
    m_GPN = GPN
End Sub

Public Property Get GPN() As String
    GPN = m_GPN
End Property
Public Property Let GPN(ByVal sGPN As String)
    m_GPN = sGPN
End Property
Public Property Get Description() As String
    Description = m_Description
End Property
Public Property Let Description(ByVal sDesc As String)
    m_Description = sDesc
End Property
Public Property Get Revision() As String
    Revision = m_Revision
End Property
Public Property Let Revision(ByVal sRevision As String)
    m_Revision = sRevision
End Property
Public Property Get TaiwanStock() As Long
    TaiwanStock = m_TaiwanStock
End Property
Public Property Let TaiwanStock(ByVal sStock As Long)
    m_TaiwanStock = sStock
End Property
Public Property Get OlatheStock() As Long
    OlatheStock = m_OlatheStock
End Property
Public Property Let OlatheStock(ByVal sStock As Long)
    m_OlatheStock = sStock
End Property
Public Property Get SalemStock() As Long
    SalemStock = m_SalemStock
End Property
Public Property Let SalemStock(ByVal sStock As Long)
    m_SalemStock = sStock
End Property
Public Property Get TaiwanCost() As Single
    TaiwanCost = m_TaiwanCost
End Property
Public Property Let TaiwanCost(ByVal sCost As Single)
    m_TaiwanCost = sCost
End Property
Public Property Get OlatheCost() As Single
    OlatheCost = m_OlatheCost
End Property
Public Property Let OlatheCost(ByVal sCost As Single)
    m_OlatheCost = sCost
End Property
Public Property Get SalemCost() As Single
    SalemCost = m_SalemCost
End Property
Public Property Let SalemCost(ByVal sCost As Single)
    m_SalemCost = sCost
End Property
Public Property Get Comment() As String
    Comment = m_Comment
End Property
Public Property Let Comment(ByVal sComment As String)
    m_Comment = sComment
End Property
Public Property Get Forecast() As String
    Forecast = m_Forecast
End Property
Public Property Let Forecast(ByVal sForecast As String)
    m_Forecast = sForecast
End Property
Public Property Get UOM() As String
    UOM = m_PrimaryUOM
End Property
Public Property Let UOM(ByVal s As String)
    m_PrimaryUOM = s
End Property

Public Function GetCost() As Double
    '
    '****************************************************************************************
    '       Title:      GetCost
    '       Author:     Jesse Simpson
    '       Function:   Retrieve the part cost information based on the previously set Stock Location
    '       Limitation: StockLocation must be set to retrieve accurate results
    '       Returns:
    '           The cost of the part in the given arena
    '
    '****************************************************************************************
    '
    If StrComp(BB.stockLocation, "taiwan", vbTextCompare) = 0 Then
        ' Taiwan cost
        GetCost = m_TaiwanCost
    ElseIf StrComp(BB.stockLocation, "olathe", vbTextCompare) = 0 Then
        ' Olathe cost
        GetCost = m_OlatheCost
    ElseIf StrComp(BB.stockLocation, "salem", vbTextCompare) = 0 Then
        ' Salem cost
        GetCost = m_SalemCost
    Else
        GetCost = 0
    End If
End Function
Public Function GetStock() As Double
    '
    '****************************************************************************************
    '       Title:      GetStock
    '       Author:     Jesse Simpson
    '       Function:   Retrieve the part Stock information based on the previously set Stock Location
    '       Limitation: StockLocation must be set to retrieve accurate results
    '       Returns:
    '           The Stock of the part in the given arena
    '
    '****************************************************************************************
    '
    If StrComp(BB.stockLocation, "taiwan", vbTextCompare) = 0 Then
        ' Taiwan Stock
        GetStock = m_TaiwanStock
    ElseIf StrComp(BB.stockLocation, "olathe", vbTextCompare) = 0 Then
        ' Olathe Stock
        GetStock = m_OlatheStock
    ElseIf StrComp(BB.stockLocation, "salem", vbTextCompare) = 0 Then
        ' Salem Stock
        GetStock = m_SalemStock
    Else
        GetStock = 0
    End If
End Function

Attribute VB_Name = "clsUploadBOMItem"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit
'
'****************************************************************************************
'       Class:          clsUploadBOMItem
'       Author:         Jesse Simpson
'       Description:    Container object for items appearing in Upload BOM worksheets
'
'****************************************************************************************
'

Private m_RefDes As clsRefDes       ' the Reference Designator object
Private m_Bub As String             ' BOM Bubble number if applicable
Private m_Comment As String         ' the Comment string
Private m_Reduced As String         ' Reduced_BOM string
Private m_GPN As String             ' the GPN used at this reference designator
Private m_Quantity As Integer       ' the Quantity of this item used in the BOM
Private m_Source As Collection      ' a collection listing BOMBOM attribute which populated each of the variables (used for "BOMBOM priority")
Private m_UOM As String             ' the UOM

Public Sub Init(ByVal RefDes As String, ByVal GPN As String, ByVal Comment As String, ByVal Quantity As Integer, Optional ByVal Reduced_BOM As String = "", Optional ByVal UOM As String = "EA", Optional ByVal Bub As String = "")
    Set m_RefDes = New clsRefDes
    m_RefDes.Init RefDes
    m_GPN = GPN
    m_Bub = Bub
    m_Comment = Comment
    m_Quantity = Quantity
    m_Reduced = Reduced_BOM
…