Since function getTableFields
uses some non-built VBA functions, they also must be included in your code for the function to work properly.
Otherwise the following error will occur: Compile error: Sub or Function not defined.
Required functions are listed below. You can get to each function's source code by clicking its name:
When adding the functions above to your VBA project, make sure you haven't done it before. If there are two different public functions with the same name in a single VBA project, the following compilation error is thrown: Compile error: Ambiguous name detected: function_name.
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
'**********************************************************************************************************
' Name: getTableFields
' Author: mielk | 2014-12-14
'
' Comment: Function to return the list of fields defined in the given database table.
'
' Parameters:
' connection Object of ADODB.Connection class, used to connect to the database.
' tableName The name of a table for which fields name are to be returned.
'
' Returns:
' String() Array containing the names of fields defined in the given table.
'
'
' Exceptions:
' TableNotFoundException Thrown if there is not table with the given name.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2014-12-14 mielk Function created.
'**********************************************************************************************************
Public Function getTableFields(connection As Object, tableName As String) As String()
Const METHOD_NAME As String = "getTableFields"
'------------------------------------------------------------------------------------------------------
Const SQL_STRING As String = "SELECT * FROM {0} WHERE 1 = 2"
Dim fields() As String
Dim rs As Object '.................................................................. ADODB.Recordset
Dim sqlString As String
'------------------------------------------------------------------------------------------------------
Dim i As Long
Dim fld As Object
'------------------------------------------------------------------------------------------------------
'Insert the given table name to the template SQL query... -------------------------------------------|
sqlString = formatString(SQL_STRING, tableName) '|
'|
'... and execute this query on the given Connection. --------------------------------------------| '|
On Error GoTo TableNotFoundException '| '|
Set rs = connection.execute(sqlString) '| '|
On Error GoTo 0 '| '|
'------------------------------------------------------------------------------------------------| '|
'|
'----------------------------------------------------------------------------------------------------|
'Read the fields headers from the recordset obtained above and insert them into the result array. ---|
ReDim fields(1 To rs.fields.Count) '|
'|
'Iterate through each fields from the recordset and put each value into the result array.--------| '|
For Each fld In rs.fields '| '|
i = i + 1 '| '|
fields(i) = VBA.LCase$(fld.name) '| '|
Next fld '| '|
'------------------------------------------------------------------------------------------------| '|
'|
getTableFields = fields '|
'----------------------------------------------------------------------------------------------------|
'==========================================================================================================
ExitPoint:
'Clear reference to recordset, since it is not needed anymore. --------------------------------------|
If Not rs Is Nothing Then '|
'|
'Sometimes happends that this operations crashes. Since it is not very crucial, any error ---| '|
'in this process will be just ignored. '| '|
On Error Resume Next '| '|
Call rs.Close '| '|
On Error GoTo 0 '| '|
'--------------------------------------------------------------------------------------------| '|
'|
Set rs = Nothing '|
'|
End If '|
'----------------------------------------------------------------------------------------------------|
Exit Function
'----------------------------------------------------------------------------------------------------------
TableNotFoundException:
'Error handler for the case if table with the given name has not been found using the given connection.
GoTo ExitPoint
End Function