14_ExcelVBE/getModels.bas at master · AlignmentSystems/14_ExcelVBE · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
Attribute VB_Name = "getModels"
Option Explicit
Option Compare Text
Option Base 0
'============================================================================================================================
'
'
'   Author      :       John Greenan
'   Email       :       john.greenan@alignment-systems.com
'   Company     :       Alignment Systems Limited
'   Date        :       18th April 2015
'
'   Purpose     :       Matching Engine in Excel VBA for Alignment Systems Limited
'
'   References  :       See VB Module FL for list extracted from VBE
'   References  :
'============================================================================================================================

Function EntryPointGetConnections()
'============================================================================================================================
'
'
'   Author      :       John Greenan
'   Email       :       john.greenan@alignment-systems.com
'   Company     :       Alignment Systems Limited
'   Date        :       18th April 2015
'
'   Purpose     :       Matching Engine in Excel VBA for Alignment Systems Limited
'
'   References  :       See VB Module FL for list extracted from VBE
'   References  :
'============================================================================================================================
'Constants
Const cstrTableName As String = "Table="
Const cstrRecordCount As String = "RecordCount="
Const cstrConnectionText As String = "ConnectionText="
Const cstrConnectionType As String = "ConnectionType="
Const cstrColumnName As String = "ColumnName="
Const cstrDataType As String = "DataType="
Const cstrPrimaryKeyTableName As String = "PrimaryKeyTableName="
Const cstrPrimaryKeyColumnName As String = "PrimaryKeyColumnName"
Const cstrForeignKeyTableName As String = "ForeignKeyTableName"
Const cstrForeignKeyColumnName As String = "ForeignKeyColumnName"
'Variables
Dim oWorkbook As Excel.Workbook
Dim strConnectionType As String
Dim oModel As Excel.Model
Dim oTable As Excel.ModelTable
Dim oTableColumn As Excel.ModelTableColumn
Dim oRelationship As Excel.ModelRelationship


Set oWorkbook = ThisWorkbook
Debug.Print "Relationships--------------------------------------"

For Each oRelationship In oWorkbook.Model.ModelRelationships
    With oRelationship
        Debug.Print .PrimaryKeyTable.Name, .PrimaryKeyColumn.Name, .ForeignKeyTable.Name, .ForeignKeyColumn.Name
    End With
Next


Debug.Print "---------------------------------------------------"
Debug.Print "Tables---------------------------------------------"
For Each oTable In oWorkbook.Model.ModelTables
    With oTable
        strConnectionType = DecodeConnectionType(.SourceWorkbookConnection.WorksheetDataConnection.CommandType)
        Debug.Print cstrTableName & .Name, cstrRecordCount & .RecordCount, cstrConnectionText & .SourceWorkbookConnection.WorksheetDataConnection.CommandText, cstrConnectionType & strConnectionType
        strConnectionType = ""
    End With
    For Each oTableColumn In oTable.ModelTableColumns
        With oTableColumn
            Debug.Print cstrColumnName & .Name, cstrDataType & DecodeParameter(.DataType)
        End With
    Next
    Debug.Print "---------------------------------------------------"
Next

End Function

Function DecodeParameter(Incoming As Excel.XlParameterDataType) As String
'============================================================================================================================
'
'
'   Author      :       John Greenan
'   Email       :       john.greenan@alignment-systems.com
'   Company     :       Alignment Systems Limited
'   Date        :       18th April 2015
'
'   Purpose     :       Matching Engine in Excel VBA for Alignment Systems Limited
'
'   References  :       See VB Module FL for list extracted from VBE
'   References  :
'============================================================================================================================

Select Case Incoming
    Case Excel.XlParameterDataType.xlParamTypeBigInt
        DecodeParameter = "xlParamTypeBigInt"
    Case Excel.XlParameterDataType.xlParamTypeBinary
        DecodeParameter = "xlParamTypeBinary"
    Case Excel.XlParameterDataType.xlParamTypeBit
        DecodeParameter = "xlParamTypeBit"
    Case Excel.XlParameterDataType.xlParamTypeChar
        DecodeParameter = "xlParamTypeChar"
    Case Excel.XlParameterDataType.xlParamTypeDate
        DecodeParameter = "xlParamTypeDate"
    Case Excel.XlParameterDataType.xlParamTypeDecimal
        DecodeParameter = "xlParamTypeDecimal"
    Case Excel.XlParameterDataType.xlParamTypeDouble
        DecodeParameter = "xlParamTypeDouble"
    Case Excel.XlParameterDataType.xlParamTypeFloat
        DecodeParameter = "xlParamTypeFloat"
    Case Excel.XlParameterDataType.xlParamTypeInteger
        DecodeParameter = "xlParamTypeInteger"
    Case Excel.XlParameterDataType.xlParamTypeLongVarBinary
        DecodeParameter = "xlParamTypeLongVarBinary"
    Case Excel.XlParameterDataType.xlParamTypeLongVarChar
        DecodeParameter = "xlParamTypeLongVarChar"
    Case Excel.XlParameterDataType.xlParamTypeNumeric
        DecodeParameter = "xlParamTypeNumeric"
    Case Excel.XlParameterDataType.xlParamTypeReal
        DecodeParameter = "xlParamTypeReal"
    Case Excel.XlParameterDataType.xlParamTypeSmallInt
        DecodeParameter = "xlParamTypeSmallInt"
    Case Excel.XlParameterDataType.xlParamTypeTime
        DecodeParameter = "xlParamTypeTime"
    Case Excel.XlParameterDataType.xlParamTypeTimestamp
        DecodeParameter = "xlParamTypeTimestamp"
    Case Excel.XlParameterDataType.xlParamTypeTinyInt
        DecodeParameter = "xlParamTypeTinyInt"
    Case Excel.XlParameterDataType.xlParamTypeUnknown
        DecodeParameter = "xlParamTypeUnknown"
    Case Excel.XlParameterDataType.xlParamTypeVarBinary
        DecodeParameter = "xlParamTypeVarBinary"
    Case Excel.XlParameterDataType.xlParamTypeVarChar
        DecodeParameter = "xlParamTypeVarChar"
    Case Excel.XlParameterDataType.xlParamTypeWChar
        DecodeParameter = "xlParamTypeWChar"
    Case Else
        DecodeParameter = "[UNKNOWN]"
End Select


End Function


Function DecodeConnectionType(Incoming As Excel.XlConnectionType) As String
'============================================================================================================================
'
'
'   Author      :       John Greenan
'   Email       :       john.greenan@alignment-systems.com
'   Company     :       Alignment Systems Limited
'   Date        :       6th April 2014
'
'   Purpose     :       Matching Engine in Excel VBA for Alignment Systems Limited
'
'   References  :       See VB Module FL for list extracted from VBE
'   References  :
'============================================================================================================================

Select Case Incoming
    Case Excel.XlConnectionType.xlConnectionTypeDATAFEED
        DecodeConnectionType = "DATAFEED"
    Case Excel.XlConnectionType.xlConnectionTypeMODEL
        DecodeConnectionType = "MODEL"
    Case Excel.XlConnectionType.xlConnectionTypeNOSOURCE
        DecodeConnectionType = "NOSOURCE"
    Case Excel.XlConnectionType.xlConnectionTypeODBC
        DecodeConnectionType = "ODBC"
    Case Excel.XlConnectionType.xlConnectionTypeOLEDB
        DecodeConnectionType = "OLEDB"
    Case Excel.XlConnectionType.xlConnectionTypeTEXT
        DecodeConnectionType = "TEXT"
    Case Excel.XlConnectionType.xlConnectionTypeWEB
        DecodeConnectionType = "WEB"
    Case Excel.XlConnectionType.xlConnectionTypeWORKSHEET
        DecodeConnectionType = "WORKSHEET"
    Case Excel.XlConnectionType.xlConnectionTypeXMLMAP
        DecodeConnectionType = ""
    Case Else
        DecodeConnectionType = "[UNKNOWN]"
End Select

End Function