Security Binding Export to Excel

I altered the Attachment Binding Export to Excel macro to do the same for securities and their values:

Option Explicit

' Dim ER/Studio variables
Dim theDiagram As Diagram
Dim theSub As SubModel
Dim theEnt As Entity
Dim theAttr As AttributeObj
Dim theBoundSecurity As BoundSecurityProperty
Dim theSecurity As SecurityProperty
Dim theSecurityPropetyName As String
Dim theSecurityValue As String
Dim theModel As Model
Dim curRow As Long
Dim curCol As Long
Dim Excel As Object
Dim workBook As Object
Dim sheet As Object

Type HashNode
    SiblingNode As Variant
    Value As String
    Key As Long
End Type

Dim SecurityParentDDMap() As HashNode
Dim SecurityMapHashSize As Long

Sub Main

    Set theDiagram = DiagramManager.ActiveDiagram

    InitHashTables

    Set Excel = CreateObject("Excel.Application")
    Set workBook = Excel.Workbooks.Add

    initWorkBook workBook

    ExportSubmodelSecurities
    AutofitAllUsed

    ExportEntitySecurities
    AutofitAllUsed

    ExportAttributeSecurities
    AutofitAllUsed

    Set sheet = workBook.worksheets("Entity")
    sheet.Activate

    MsgBox "Done", vbInformation

    Excel.Visible = True

End Sub
Sub PrintCell(value As String, row As Long, col As Long, rowInc As Integer, colInc As Integer)
    Excel.Cells(row, col).Value = value
    curRow = curRow + rowInc
    curCol = curCol + colInc
End Sub
Sub initWorkBook ( wb As Variant )

    Dim ws As Object


    Set ws = wb.worksheets.Add

    With ws
        .Name = "Attribute"
        .cells(1, 1).Value = "Model Name"
        .cells(1, 2).Value = "Entity/Table Name"
        .cells(1, 3).Value = "Attribute/Column Name"
        .cells(1, 4).Value = "Enterprise DD Name"
        .cells(1, 5).Value = "Security Type Name"
        .cells(1, 6).Value = "Security Name"
        .cells(1, 7).Value = "Value Override"
        .cells(1, 8).Value = "Value Default"
    End With


    Set ws = wb.worksheets.Add

    With ws
        .Name = "Entity"
        .cells(1, 1).Value = "Model Name"
        .cells(1, 2).Value = "Entity/Table Name"
        .cells(1, 3).Value = "Enterprise DD Name"
        .cells(1, 4).Value = "Security Type Name"
        .cells(1, 5).Value = "Security Name"
        .cells(1, 6).Value = "Value Override"
        .cells(1, 7).Value = "Value Default"
    End With

    Set ws = wb.worksheets.Add

    With ws
        .Name = "Submodel"
        .cells(1, 1).Value = "Model Name"
        .cells(1, 2).Value = "Submodel Name"
        .cells(1, 3).Value = "Enterprise DD Name"
        .cells(1, 4).Value = "Security Type Name"
        .cells(1, 5).Value = "Security Name"
        .cells(1, 6).Value = "Value Override"
        .cells(1, 7).Value = "Value Default"
    End With


End Sub

Sub ExportSubmodelSecurities
    curRow = 2
    curCol = 1

    Set sheet = workBook.worksheets("Submodel")
    sheet.Activate

    Dim theDict As Dictionary
    Dim theDictName As String
    Dim ParentEDDGuid As String

    For Each theModel In theDiagram.Models
        For Each theSub In theModel.SubModels
            'determine if there are any bound attachments
            If theSub.BoundSecurityProperties.Count > 0 Then
                'loop through bound attachments
                For Each theBoundSecurity In theSub.BoundSecurityProperties

                    ParentEDDGuid = ""
                    theDictName = ""

                    PrintCell theModel.Name, curRow, curCol, 0, 1

                    'Write the Submodel Name
                    PrintCell theSub.Name, curRow, curCol, 0, 1

                    'set attachment object to the base attachment from the data dictionary.
                    Set theSecurity = theBoundSecurity.SecurityProperty

                    'grab and output the parent data dictionary.
                    ParentEDDGuid = FindSecurityParentEDDGuid(theSecurity.ID)
                    If ParentEDDGuid = "" Then
                        Set theDict = DiagramManager.ActiveDataDictionary
                    Else
                        Set theDict = theDiagram.EnterpriseDataDictionaries(ParentEDDGuid)
                    End If
                    If Not theDict Is Nothing Then
                        theDictName = theDict.Name
                    End If
                    PrintCell theDictName, curRow, curCol, 0, 1

                    'output the type the attachment belongs to (again from the dictionary)
                    PrintCell theSecurity.SecurityType.Name, curRow, curCol, 0, 1

                    'output the name (from the attachment in dictionary)
                    PrintCell theSecurity.Name, curRow, curCol, 0, 1

                    'output the override value, this comes from the bound attachment since the value
                    'is overridden on the table
                    PrintCell theBoundSecurity.ValueOverride, curRow, curCol, 0, 1

                    'output the default value, this is from the attachment in the data dictionary.
                    PrintCell theBoundSecurity.ValueCurrent, curRow, curCol, 0, 1

                    curRow = curRow + 1
                    curCol = 1

                Next
            End If
        Next
    Next
End Sub

Sub ExportEntitySecurities
    curRow = 2
    curCol = 1

    Set sheet = workBook.worksheets("Entity")
    sheet.Activate

    Dim theDict As Dictionary
    Dim theDictName As String
    Dim ParentEDDGuid As String

    For Each theModel In theDiagram.Models
        For Each theEnt In theModel.Entities
            'determine if there are any bound attachments
            If theEnt.BoundSecurityProperties.Count > 0 Then
                'loop through bound attachments
                For Each theBoundSecurity  In theEnt.BoundSecurityProperties

                    ParentEDDGuid = ""
                    theDictName = ""

                    PrintCell theModel.Name, curRow, curCol, 0, 1

                    'Write the Entity Name
                    PrintCell IIf(theModel.Logical, theEnt.EntityName, theEnt.TableName), curRow, curCol, 0, 1

                    'set attachment object to the base attachment from the data dictionary.
                    Set theSecurity = theBoundSecurity.SecurityProperty

                    'grab and output the parent data dictionary.
                    ParentEDDGuid = FindSecurityParentEDDGuid(theSecurity.ID)
                    If ParentEDDGuid = "" Then
                        Set theDict = DiagramManager.ActiveDataDictionary
                    Else
                        Set theDict = theDiagram.EnterpriseDataDictionaries(ParentEDDGuid)
                    End If
                    If Not theDict Is Nothing Then
                        theDictName = theDict.Name
                    End If
                    PrintCell theDictName, curRow, curCol, 0, 1

                    'output the type the attachment belongs to (again from the dictionary)
                    PrintCell theSecurity.SecurityType.Name, curRow, curCol, 0, 1

                    'output the name (from the attachment in dictionary)
                    PrintCell theSecurity.Name, curRow, curCol, 0, 1

                    'output the override value, this comes from the bound attachment since the value
                    'is overridden on the table
                    PrintCell theBoundSecurity.ValueOverride, curRow, curCol, 0, 1

                    'output the default value, this is from the attachment in the data dictionary.
                    PrintCell theBoundSecurity.ValueCurrent, curRow, curCol, 0, 1

                    curRow = curRow + 1
                    curCol = 1

                Next
            End If
        Next
    Next
End Sub

Sub ExportAttributeSecurities
    curRow = 2
    curCol = 1

    Set sheet = workBook.worksheets("Attribute")
    sheet.Activate

    Dim theDict As Dictionary
    Dim theDictName As String
    Dim ParentEDDGuid As String

    For Each theModel In theDiagram.Models
        For Each theEnt In theModel.Entities
            For Each theAttr In theEnt.Attributes
                'determine if there are any bound attachments
                If theAttr.BoundSecurityProperties.Count > 0 Then

                    'loop through bound attachments
                    For Each theBoundSecurity  In theAttr.BoundSecurityProperties

                        ParentEDDGuid = ""
                        theDictName = ""

                        PrintCell theModel.Name, curRow, curCol, 0, 1

                        'Write the Entity Name
                        PrintCell IIf(theModel.Logical, theEnt.EntityName, theEnt.TableName), curRow, curCol, 0, 1

                        'Write the Attribute Name
                        PrintCell IIf(theModel.Logical, theAttr.AttributeName, theAttr.ColumnName), curRow, curCol, 0, 1

                        'set attachment object to the base attachment from the data dictionary.
                        Set theSecurity = theBoundSecurity.SecurityProperty

                        'grab and output the parent data dictionary.
                        ParentEDDGuid = FindSecurityParentEDDGuid(theSecurity.ID)
                        If ParentEDDGuid = "" Then
                            Set theDict = DiagramManager.ActiveDataDictionary
                        Else
                            Set theDict = theDiagram.EnterpriseDataDictionaries(ParentEDDGuid)
                        End If
                        If Not theDict Is Nothing Then
                            theDictName = theDict.Name
                        End If
                        PrintCell theDictName, curRow, curCol, 0, 1

                        'output the type the attachment belongs to (again from the dictionary)
                        PrintCell theSecurity.SecurityType.Name, curRow, curCol, 0, 1

                        'output the name (from the attachment in dictionary)
                        PrintCell theSecurity.Name, curRow, curCol, 0, 1

                        'output the override value, this comes from the bound attachment since the value
                        'is overridden on the table
                        PrintCell theBoundSecurity.ValueOverride, curRow, curCol, 0, 1

                        'output the default value, this is from the attachment in the data dictionary.
                        PrintCell theBoundSecurity.ValueCurrent, curRow, curCol, 0, 1

                        curRow = curRow + 1
                        curCol = 1
                    Next theBoundSecurity
                End If
            Next
        Next
    Next
End Sub
Sub AutofitAllUsed()
    Dim x As Long

    For x = 1 To Excel.ActiveSheet.UsedRange.Columns.Count
        Excel.ActiveSheet.UsedRange.Columns(x).EntireColumn.autofit
    Next x
End Sub
Sub InitHashTables()

    Dim theDict As Dictionary
    Dim theSecType As SecurityType
    Dim theSecurity As SecurityProperty
    Dim maxSecCnt As Long
    maxSecCnt = 0

    For Each theDict In theDiagram.EnterpriseDataDictionaries
        For Each theSecType In theDict.SecurityTypes
            maxSecCnt = maxSecCnt + theSecType.SecurityProperties.Count
        Next theSecType
    Next theDict

    SecurityMapHashSize = GetPrimeHashTableSize(maxSecCnt)
    ReDim SecurityParentDDMap(SecurityMapHashSize)

    For Each theDict In theDiagram.EnterpriseDataDictionaries
        For Each theSecType In theDict.SecurityTypes
            For Each theSecurity In theSecType.SecurityProperties
                InsertSecurityDDPair theSecurity.ID, theDict.GUID
            Next theSecurity
        Next theSecType
    Next theDict

End Sub

Sub InsertSecurityDDPair(ByVal ObjID As Long, ByVal EDDGuid As String)

    Dim newNode As HashNode
    Dim curNode As HashNode
    Dim ObjSlot As Long

    newNode.Key = ObjID
    newNode.Value = EDDGuid

    ObjSlot = HashID(ObjID, SecurityMapHashSize)
    curNode = SecurityParentDDMap(ObjSlot)
    newNode.SiblingNode = curNode
    SecurityParentDDMap(ObjSlot) = newNode

End Sub

Function FindSecurityParentEDDGuid(ByVal ObjID As Long) As String

    Dim searchNode As HashNode
    Dim ObjSlot As Long

    ObjSlot = HashID(ObjID, SecurityMapHashSize)
    searchNode = SecurityParentDDMap(ObjSlot)
    While (searchNode.Key > 0 And searchNode.Value <> "")

        If searchNode.Key = ObjID Then
            Exit While
        Else
            searchNode = searchNode.SiblingNode
        End If

    Wend

    FindSecurityParentEDDGuid = searchNode.Value

End Function

Function HashID(ByVal ObjID As Long, ByVal HashSize As Long) As Long

    HashID = ObjID Mod HashSize

End Function

Function GetPrimeHashTableSize(ByVal ExpectedObjCount As Long)

    ' Use minimum size of 53
    If ExpectedObjCount < 53 Then
        GetPrimeHashTableSize = 53
        Exit Function
    End If

    If ExpectedObjCount > 101611 Then
        If ExpectedObjCount > 848737 Then
            If ExpectedObjCount > 2452889 Then
                If ExpectedObjCount > 4169929 Then
                    GetPrimeHashTableSize = 7088891
                    Exit Function
                Else
                    GetPrimeHashTableSize = 4169929
                    Exit Function
                End If
            ElseIf ExpectedObjCount > 1442863 Then
                GetPrimeHashTableSize = 2452889
                Exit Function
            Else
                GetPrimeHashTableSize = 1442863
                Exit Function
            End If
        ElseIf ExpectedObjCount > 293677 Then
            If ExpectedObjCount > 499253 Then
                GetPrimeHashTableSize = 848737
                Exit Function
            Else
                GetPrimeHashTableSize = 499253
                Exit Function
            End If
        ElseIf ExpectedObjCount > 172741 Then
            GetPrimeHashTableSize = 293677
            Exit Function
        Else
            GetPrimeHashTableSize = 172741
            Exit Function
        End If
    ElseIf ExpectedObjCount > 1451 Then
        If ExpectedObjCount > 12157 Then
            If ExpectedObjCount > 35159 Then
                If ExpectedObjCount > 59771 Then
                    GetPrimeHashTableSize = 101611
                    Exit Function
                Else
                    GetPrimeHashTableSize = 59771
                    Exit Function
                End If
            ElseIf ExpectedObjCount > 20681 Then
                GetPrimeHashTableSize = 35159
                Exit Function
            Else
                GetPrimeHashTableSize = 20681
                Exit Function
            End If
        ElseIf ExpectedObjCount > 4201 Then
            If ExpectedObjCount > 7151 Then
                GetPrimeHashTableSize = 12157
                Exit Function
            Else
                GetPrimeHashTableSize = 7151
                Exit Function
            End If
        ElseIf ExpectedObjCount > 2467 Then
            GetPrimeHashTableSize = 4201
            Exit Function
        Else
            GetPrimeHashTableSize = 2467
            Exit Function
        End If
    ElseIf ExpectedObjCount > 167 Then
        If ExpectedObjCount > 499 Then
            If ExpectedObjCount > 853 Then
                GetPrimeHashTableSize = 1451
                Exit Function
            Else
                GetPrimeHashTableSize = 853
                Exit Function
            End If
        ElseIf ExpectedObjCount > 289 Then
            GetPrimeHashTableSize = 499
            Exit Function
        Else
            GetPrimeHashTableSize = 289
            Exit Function
        End If
    ElseIf ExpectedObjCount > 53 Then
        If ExpectedObjCount > 97 Then
            GetPrimeHashTableSize = 167
            Exit Function
        Else
            GetPrimeHashTableSize = 97
            Exit Function
        End If
    ElseIf ExpectedObjCount > 29 Then
        GetPrimeHashTableSize = 53
        Exit Function
    Else
        GetPrimeHashTableSize = 29
        Exit Function
    End If

End Function