3
\$\begingroup\$

SQLiteDB VBA Library is a set of VBA helper functions for the SQLite engine. The primary motivation behind this project is to provide convenient access to extended introspection features. Because of its generality, ADODB/ADOX libraries provide only limited metadata information. The Introspection subpackage of this library relies on the generic SQL querying mechanism and specialized SQL queries. It facilitates access to complete information about both the features of the active engine used and objects/attributes of the attached database. The library uses the ADODB package and relies on the Christian Werner's SQLiteODBC driver (I use a custom compiled binary that embeds a recent version of SQLite, as described here).

Class diagram FigClassDiagram

Note, this post only covers the core functionality. Further documentation is available on GitHub, and complete source code, tests, and examples are available from the project repository.

The three classes at the top of the diagram form the Introspection subpackage responsible for metadata-related SQL code, with SQLiteSQLDbInfo being the top-level object. It implements a portion of the functionality, proxies functionality provided by SQLiteSQLDbIdxFK, and encapsulates SQLiteSQLEngineInfo.


SQLiteSQLDbInfo

'@Folder "SQLiteDB.Introspection"
'@ModuleDescription "SQL queries for retrieving SQLite database metadata."
'@PredeclaredId
'@Exposed
'@IgnoreModule ProcedureNotUsed
Option Explicit

Private Type TSQLiteSQLDbInfo
    Schema As String
    Engine As SQLiteSQLEngineInfo
End Type
Private this As TSQLiteSQLDbInfo


Private Sub Class_Initialize()
    this.Schema = "main"
    Set this.Engine = SQLiteSQLEngineInfo
End Sub


Private Sub Class_Terminate()
    Set this.Engine = Nothing
End Sub


'''' @ClassMethodStrict
'''' This method should only be used on the default instance
''''
'@DefaultMember
'@Description "Default factory"
Public Function Create(Optional ByVal Schema As String = "main") As SQLiteSQLDbInfo
    Dim Instance As SQLiteSQLDbInfo
    Set Instance = New SQLiteSQLDbInfo
    Instance.Init Schema
    Set Create = Instance
End Function


Public Sub Init(ByVal Schema As String)
    this.Schema = Schema
End Sub


'@Description "Exposes SQLiteSQLEngineInfo introspection queries"
Public Property Get Engine() As SQLiteSQLEngineInfo
    Set Engine = this.Engine
End Property


'@Description "Generates a query returning the list of attached databases"
Public Property Get Databases() As String
    Databases = "SELECT name, file FROM pragma_database_list"
End Property


'''' @Proxy
'@Description "Generates a query returning all non-system database objects."
Public Function GetDbSchema(Optional ByVal Schema As String = vbNullString) As String
    GetDbSchema = SQLiteSQLDbIdxFK.DbSchema(IIf(Len(Schema) > 0, Schema, this.Schema))
End Function


'''' @Proxy
'@Description "Generates a query returning all non-system database objects, but triggers"
Public Function DbSchemaNoTriggers(Optional ByVal Schema As String = vbNullString) As String
    DbSchemaNoTriggers = SQLiteSQLDbIdxFK.DbSchemaNoTriggers(IIf(Len(Schema) > 0, Schema, this.Schema))
End Function


'''' @Proxy
'@Description "Generates a query returning triggers"
Public Function Triggers(Optional ByVal Schema As String = vbNullString) As String
    Triggers = SQLiteSQLDbIdxFK.Triggers(IIf(Len(Schema) > 0, Schema, this.Schema))
End Function


'''' For some reason, running SELECT * FROM <schema>.pragma_integrity_check
'''' with several attached databases gives the result as if <schema> is
'''' ignored and all attached databases are checked. Prefer to run this
'''' check when the only attached database is the one being checked.
'@Description "Generates a query running integrity check."
Public Property Get CheckIntegrity() As String
    CheckIntegrity = "SELECT * FROM pragma_integrity_check"
End Property


'''' For some reason, running SELECT * FROM <schema>.pragma_foreign_key_check
'''' with several attached databases gives the result as if <schema> is
'''' ignored and all attached databases are checked. Prefer to run this
'''' check when the only attached database is the one being checked.
'@Description "Generates a query running integrity check."
Public Property Get CheckFKs() As String
    CheckFKs = "SELECT * FROM pragma_foreign_key_check"
End Property


'''' @Proxy
'@Description "Generates a query returning database tables."
Public Function Tables(Optional ByVal Schema As String = vbNullString) As String
    Tables = SQLiteSQLDbIdxFK.Tables(IIf(Len(Schema) > 0, Schema, this.Schema))
End Function


'''' @Proxy
'@Description "Generates a query returning all foreing keys in the SQLite database"
Public Property Get ForeingKeys() As String
    ForeingKeys = SQLiteSQLDbIdxFK.ForeingKeys(this.Schema)
End Property


'''' @Proxy
'@Description "Generates a query returning all indices in the SQLite database"
Public Function Indices(Optional ByVal NonSys As Boolean = True) As String
    Indices = SQLiteSQLDbIdxFK.Indices(this.Schema, NonSys)
End Function


'''' @Proxy
'''' See the called class for details
'@Description "Generates a query returning child columns for all foreing keys and corresponding indices."
Public Property Get FKChildIndices() As String
    FKChildIndices = SQLiteSQLDbIdxFK.FKChildIndices(this.Schema)
End Property


'''' @Proxy
'''' See the called class for details
'@Description "Generates a query returning similar indices."
Public Property Get SimilarIndices() As String
    SimilarIndices = SQLiteSQLDbIdxFK.SimilarIndices(this.Schema)
End Property


'@Description "Generates a query returning table's columns."
Public Function TableColumns(ByVal TableName As String) As String
    Guard.EmptyString TableName
    TableColumns = "SELECT * " & _
                   "FROM " & this.Schema & ".pragma_table_xinfo('" & TableName & "')"
End Function


'@Description "Generates a query returning table's columns with placeholder columns."
Public Function TableColumnsEx(ByVal TableName As String) As String
    Guard.EmptyString TableName
    TableColumnsEx = "SELECT * , 0 AS [unique], '' as [check], '' as [collate] " & _
                     "FROM " & this.Schema & ".pragma_table_info('" & TableName & "')"
End Function


'@Description "Generates a query returning table's SQL."
Public Function TableSQL(ByVal TableName As String) As String
    Guard.EmptyString TableName
    TableSQL = "SELECT sql " & _
               "FROM sqlite_master " & _
               "WHERE type = 'table' AND name = '" & TableName & "'"
End Function


'@Description "Generates a query returning table's foreign keys."
Public Function TableForeingKeys(ByVal TableName As String) As String
    TableForeingKeys = "SELECT * " & _
                       "FROM " & this.Schema & ".pragma_foreign_key_list('" & TableName & "')"
End Function

SQLiteSQLDbIdxFK

Bulky code related to database indices and foreign keys goes into a separate module.

'@Folder "SQLiteDB.Introspection"
'@ModuleDescription "SQL queries for retrieving detailed information on database indices and foreign keys."
'@PredeclaredId
''''
'''' Logically, this module is a part of SQLiteSQLDbInfo, and this FK/IDX code is
'''' placed in a separate module simply to isolate the large amount of SQL code.
'''' All methods of this module are exposed by SQLiteSQLDbInfo via composition.
'''' This class is not supposed to be used directly, and it does not need to be
'''' instantiated: all functionality can be used via the default instance.
''''
Option Explicit


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning database tables, skipping
'''' system tables (prefixed with "sqlite_") and ordering by ROWID
'''' (in order of creation). If requested, a CTE WITH term is
'''' generated.
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''   CTEWITH (boolean, optional, False):
''''     If True, format as a CTE WITH term
''''
'''' Returns:
''''   String, containing the query
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.Tables
''''   SELECT name, sql
''''   FROM main.sqlite_master
''''   WHERE type = 'table' AND (name NOT LIKE 'sqlite_%')
''''   ORDER BY ROWID ASC
''''
''''   >>> ?SQLiteSQLDbIdxFK.Tables(, True)
''''   t AS (
''''       SELECT name, sql
''''       FROM main.sqlite_master
''''       WHERE type = 'table' AND (name NOT LIKE 'sqlite_%')
''''       ORDER BY ROWID ASC
''''   )
''''
'@Description "Generates a query returning database tables."
Public Function Tables(Optional ByVal Schema As String = "main", _
                       Optional ByVal CTEWITH As Boolean = False) As String
    Dim Indent As String
    Dim Query As String
    Indent = IIf(CTEWITH, "    ", vbNullString)
    Query = Indent & Join(Array( _
        "SELECT tbl_name, sql", _
        "FROM " & Schema & ".sqlite_master", _
        "WHERE type = 'table' AND (name NOT LIKE 'sqlite_%')", _
        "ORDER BY ROWID ASC" _
    ), vbNewLine & Indent)
    Tables = IIf(CTEWITH, "t AS (" & vbNewLine & Query & vbNewLine & ")", Query)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning database views ordered by ROWID
'''' (in order of creation).
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''
'''' Returns:
''''   String, containing the query
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.Views
''''   SELECT tbl_name, sql
''''   FROM main.sqlite_master
''''   WHERE type = 'view'
''''   ORDER BY ROWID ASC
''''
'@Description "Generates a query returning database views."
Public Function Views(Optional ByVal Schema As String = "main") As String
    Views = Join(Array( _
        "SELECT tbl_name, sql", _
        "FROM " & Schema & ".sqlite_master", _
        "WHERE type = 'view'", _
        "ORDER BY ROWID ASC" _
    ), vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning database triggers ordered by ROWID
'''' (in order of creation).
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''
'''' Returns:
''''   String, containing the query
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.Triggers
''''   SELECT tbl_name, sql
''''   FROM main.sqlite_master
''''   WHERE type = 'trigger'
''''   ORDER BY ROWID ASC
''''
'@Description "Generates a query returning database triggers."
Public Function Triggers(Optional ByVal Schema As String = "main") As String
    Triggers = Join(Array( _
        "SELECT tbl_name, sql", _
        "FROM " & Schema & ".sqlite_master", _
        "WHERE type = 'trigger'", _
        "ORDER BY ROWID ASC" _
    ), vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning all non-system database objects
'''' ordered by type (tables, indices, views, triggers) and then by ROWID.
'''' The query returns two columns (sql, type_id).
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''
'''' Returns:
''''   String, containing the query
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.DbSchema
''''   SELECT sql, (CASE type
''''       WHEN 'table' THEN 0
''''       WHEN 'index' THEN 1
''''       WHEN 'view'  THEN 3
''''                    ELSE 4
''''                    END) AS type_id
''''   FROM main.sqlite_master
''''   WHERE name NOT like 'sqlite_%'
''''   ORDER BY type_id, _ROWID_
''''
'@Description "Generates a query returning all non-system database objects."
Public Function DbSchema(Optional ByVal Schema As String = "main") As String
    DbSchema = Join(Array( _
        "SELECT sql, (CASE type", _
        "    WHEN 'table' THEN 0", _
        "    WHEN 'index' THEN 1", _
        "    WHEN 'view'  THEN 2", _
        "                 ELSE 3", _
        "                 END) AS type_id", _
        "FROM " & Schema & ".sqlite_master", _
        "WHERE name NOT like 'sqlite_%'", _
        "ORDER BY type_id, _ROWID_" _
    ), vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning all non-system database objects,
'''' except for triggers, ordered by type (tables, indices, views) and
'''' then by ROWID. The query returns two columns (sql, type_id).
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''
'''' Returns:
''''   String, containing the query
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.DbSchemaNoTriggers
''''   SELECT sql, (CASE type
''''       WHEN 'table' THEN 0
''''       WHEN 'index' THEN 1
''''                    ELSE 2
''''                    END) AS type_id
''''   FROM main.sqlite_master
''''   WHERE (name NOT like 'sqlite_%') AND type <> 'trigger'
''''   ORDER BY type_id, _ROWID_
''''
'@Description "Generates a query returning all non-system database objects."
Public Function DbSchemaNoTriggers(Optional ByVal Schema As String = "main") As String
    DbSchemaNoTriggers = Join(Array( _
        "SELECT sql, (CASE type", _
        "    WHEN 'table' THEN 0", _
        "    WHEN 'index' THEN 1", _
        "                 ELSE 2", _
        "                 END) AS type_id", _
        "FROM " & Schema & ".sqlite_master", _
        "WHERE (name NOT like 'sqlite_%') AND type <> 'trigger'", _
        "ORDER BY type_id, _ROWID_" _
    ), vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning base info on database indices ordering
'''' by ROWID (in order of creation). If requested, a CTE WITH term is generated.
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''   CTEWITH (boolean, optional, False):
''''     If True, format as a CTE WITH term
''''
'''' Returns:
''''   String, containing the query
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.IndexBase
''''   SELECT ROWID AS id, name AS idx_name, tbl_name, sql
''''   FROM main.sqlite_master
''''   WHERE type='index'
''''   ORDER BY ROWID ASC
''''
''''   >>> ?SQLiteSQLDbIdxFK.IndexBase(, True)
''''   ib AS (
''''       SELECT ROWID AS id, name AS idx_name, tbl_name, sql
''''       FROM main.sqlite_master
''''       WHERE type='index'
''''       ORDER BY ROWID ASC
''''   )
''''
'@Description "Generates a query returning indices (base info)."
Public Function IndexBase(Optional ByVal Schema As String = "main", _
                          Optional ByVal CTEWITH As Boolean = False) As String
    Dim Indent As String
    Dim Query As String
    Indent = IIf(CTEWITH, "    ", vbNullString)
    Query = Indent & Join(Array( _
        "SELECT ROWID AS id, name AS idx_name, tbl_name, sql", _
        "FROM " & Schema & ".sqlite_master", _
        "WHERE type = 'index'", _
        "ORDER BY ROWID ASC" _
    ), vbNewLine & Indent)
    IndexBase = IIf(CTEWITH, "ib AS (" & vbNewLine & Query & vbNewLine & ")", Query)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite CTE WITH term for a foreign key list.
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''
'''' Returns:
''''   String, containing the CTE WITH term
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.pForeignKeyList
''''   fkl AS (
''''       SELECT tbl_name AS child_table, [from] AS child_col0,
''''              [table] AS parent_table, [to] AS parent_col0,
''''              on_update, on_delete, id AS fk_id, seq AS fk_seq
''''       FROM t
''''       Join main.pragma_foreign_key_list(t.tbl_name)
''''       ORDER BY child_table, fk_id
''''   )
''''
'@Description "Generates a query returning a foreign key CTE WITH term."
Public Function pForeignKeyList(Optional ByVal Schema As String = "main") As String
    pForeignKeyList = Join(Array( _
        "fkl AS (", _
        "    SELECT tbl_name AS child_table, [from] AS child_col0,", _
        "           [table] AS parent_table, [to] AS parent_col0,", _
        "           on_update, on_delete, id AS fk_id, seq AS fk_seq", _
        "    FROM t", _
        "    JOIN " & Schema & ".pragma_foreign_key_list(t.tbl_name)", _
        "    ORDER BY child_table, fk_id", _
        "),", _
        "fk AS (", _
        "    SELECT *, group_concat(child_col0, ', ') AS child_cols,", _
        "              group_concat(parent_col0, ', ') AS parent_cols,", _
        "              min(fk_seq) AS min_fk_seq", _
        "    FROM fkl", _
        "    GROUP BY child_table, fk_id", _
        "    ORDER BY child_table, fk_id", _
        ")" _
    ), vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite CTE WITH term for index info & list.
'''' For each index list info and join the tables. Only use <index name> here.
'''' For multi-column indices, keep the row with the first column and generates
'''' a column list. Generate database-wide list of additional index info columns
'''' from the per-table index lists.
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''
'''' Returns:
''''   String, containing the CTE WITH term
''''
'@Description "Generates a query returning a CTE WITH term for index info & list."
Public Function pIndexInfoList(Optional ByVal Schema As String = "main") As String
    pIndexInfoList = Join(Array( _
        "ii AS (", _
        "    SELECT ib.idx_name, min(ii.seqno) AS seqno, ii.name AS col0_name, group_concat(ii.name, ', ') AS columns", _
        "    FROM ib", _
        "    JOIN " & Schema & ".pragma_index_info(ib.idx_name) AS ii", _
        "    GROUP BY idx_name", _
        "),", _
        "il AS (", _
        "    SELECT name AS idx_name, seq AS idx_seq, [unique], origin, partial", _
        "    FROM t", _
        "    JOIN " & Schema & ".pragma_index_list(tbl_name)", _
        ")" _
    ), vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'@Description "Generates a query returning all foreing keys in the SQLite database"
Public Function ForeingKeys(Optional ByVal Schema As String = "main") As String
    Dim StmtParts(0 To 5) As String
    StmtParts(0) = "WITH"
    
    '''' List all db tables
    StmtParts(1) = Tables(Schema, True) & ","
    
    '''' For each table, list foreign keys and join them to get a list of all foreign
    '''' keys for the DB. Each row contains info on a foreign key for a single column.
    '''' Yield a single row per foreign key, including multi-column keys. For multi-column
    '''' keys, keep the row with the first column and generates a column list.
    StmtParts(2) = pForeignKeyList(Schema)
    
    StmtParts(3) = "SELECT *"
    StmtParts(4) = "FROM fk AS foreign_keys"
    StmtParts(5) = "ORDER BY child_table, fk_id"
    
    ForeingKeys = Join(StmtParts, vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning database indices, ordering by ROWID.
'''' If "NonSys" = True, skip auto indices (prefixed with "sqlite_autoindex_").
''''
'@Description "Generates a query returning all indices in the SQLite database"
Public Function Indices(Optional ByVal Schema As String = "main", _
                        Optional ByVal NonSys As Boolean = True) As String
    Dim StmtParts(10 To 26) As String
    StmtParts(10) = "WITH"
    
    '''' List all db tables
    StmtParts(11) = Tables(Schema, True) & ","
    
    '''' List all db indices
    StmtParts(12) = IndexBase(Schema, True) & ","
    
    '''' For each index list info and join the tables. Only use <index name> here. For
    '''' multi-column indices, keep the row with the first column and generates a column list.
    '''' Generate database-wide list of additional index info columns from the per-table index lists
    StmtParts(13) = pIndexInfoList(Schema) & ","
    
    '''' After taking care of multi-row descriptions, add aditional columns from index list
    StmtParts(14) = "idx AS ("
    StmtParts(15) = "    SELECT ib.id, ib.idx_name, ib.tbl_name, ii.col0_name, ii.columns, ib.sql"
    StmtParts(16) = "    FROM ib, ii"
    StmtParts(17) = "    ON ib.idx_name = ii.idx_name"
    StmtParts(18) = "),"
    
    '''' Join additional info columns with index-wise list
    StmtParts(19) = "iex AS ("
    StmtParts(20) = "    SELECT idx.*, il.idx_seq, il.[unique], il.origin, il.partial"
    StmtParts(21) = "    FROM idx, il"
    StmtParts(22) = "    WHERE idx.idx_name = il.idx_name"
    StmtParts(23) = ")"
    
    StmtParts(24) = "SELECT *"
    StmtParts(25) = "FROM iex AS indices"
    StmtParts(26) = IIf(NonSys, _
                    "WHERE idx_name NOT LIKE 'sqlite_autoindex_%'" & vbNewLine, vbNullString) & _
                    "ORDER BY id"
    
    Indices = Join(StmtParts, vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Indices on child columns of foreing key relations are not mandatory,
'''' but generally should be defined. Database engine does not control whether
'''' such indices are defined. This query return a summary table showing all
'''' child columns and corresponding indices in the "idx_name" column. If this
'''' field is empty for a particular child column, the corresponding index has
'''' not been defined.
''''
'@Description "Generates a query returning child columns for all foreing keys and corresponding indices."
Public Function FKChildIndices(Optional ByVal Schema As String = "main") As String
    Dim StmtParts(10 To 34) As String
    StmtParts(10) = "WITH"
    StmtParts(11) = Tables(Schema, True) & ","
    StmtParts(12) = IndexBase(Schema, True) & ","
    StmtParts(13) = pIndexInfoList(Schema) & ","
    StmtParts(14) = "idx AS ("
    StmtParts(15) = "    SELECT ib.id, ib.idx_name, ib.tbl_name, ii.col0_name, ii.columns, ib.sql"
    StmtParts(16) = "    FROM ib, ii"
    StmtParts(17) = "    ON ib.idx_name = ii.idx_name"
    StmtParts(18) = "),"
    StmtParts(19) = "iex AS ("
    StmtParts(20) = "    SELECT idx.*, il.idx_seq, il.[unique], il.origin, il.partial"
    StmtParts(21) = "    FROM idx, il"
    StmtParts(22) = "    WHERE idx.idx_name = il.idx_name AND partial = 0"
    StmtParts(23) = "),"

    StmtParts(24) = pForeignKeyList(Schema) & ","

    '''' Join indices and foreign keys tables to see which child columns do not have indices.
    '''' Multi-column indices, having the child column set as the "prefix" are accepted.
    StmtParts(25) = "fki AS ("
    StmtParts(26) = "    SELECT fk.child_table, fk.child_cols, fk.parent_table, fk.parent_cols,"
    StmtParts(27) = "           iex.idx_name"
    StmtParts(28) = "    FROM fk"
    StmtParts(29) = "    LEFT JOIN iex"
    StmtParts(30) = "    ON fk.child_table = iex.tbl_name AND fk.child_cols = substr(iex.columns, 1, length(fk.child_cols))"
    StmtParts(31) = ")"
    StmtParts(32) = "SELECT *"
    StmtParts(33) = "FROM fki AS fkeys_childindices"
    StmtParts(34) = "ORDER BY child_table, child_cols"

    FKChildIndices = Join(StmtParts, vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' If IDX1 indexes columns (A, B) and IDX2 indexes columns (A, B, C), that is
'''' IDX1 indexes a "prefix" of IDX2, IDX2 can replace IDX1. On the other hand,
'''' depending on statistics (if for any given pair (A, B), there are very few
'''' rows), IDX2 may not be justifiable (unless it is the primary key). This
'''' query aims to return all such similar ("prefix") indices, though it has not
'''' been thoughroughly verified. It may return some "false" positive. Whether
'''' it can miss indices is not clear.
''''
'@Description "Generates a query returning similar indices."
Public Function SimilarIndices(Optional ByVal Schema As String = "main") As String
    Dim StmtParts(10 To 39) As String
    StmtParts(10) = "WITH"
    StmtParts(11) = Tables(Schema, True) & ","
    StmtParts(12) = IndexBase(Schema, True) & ","
    StmtParts(13) = pIndexInfoList(Schema) & ","
    StmtParts(14) = "idx AS ("
    StmtParts(15) = "    SELECT ib.id, ib.idx_name, ib.tbl_name, ii.col0_name, ii.columns"
    StmtParts(16) = "    FROM ib, ii"
    StmtParts(17) = "    ON ib.idx_name = ii.idx_name"
    StmtParts(18) = "),"
    StmtParts(19) = "iex AS ("
    StmtParts(20) = "    SELECT idx.*, il.idx_seq, il.[unique], il.origin, il.partial"
    StmtParts(21) = "    FROM idx, il"
    StmtParts(22) = "    WHERE idx.idx_name = il.idx_name"
    StmtParts(23) = "),"
    StmtParts(24) = "fdup AS ("
    StmtParts(25) = "    SELECT tbl_name, col0_name, count(*) AS group_size"
    StmtParts(26) = "    FROM iex"
    StmtParts(27) = "    WHERE partial = 0"
    StmtParts(28) = "    GROUP BY tbl_name, col0_name"
    StmtParts(29) = "    HAVING group_size > 1"
    StmtParts(30) = "),"
    StmtParts(31) = "idup AS ("
    StmtParts(32) = "    SELECT iex.*, fdup.group_size"
    StmtParts(33) = "    FROM iex"
    StmtParts(34) = "    JOIN fdup"
    StmtParts(35) = "    ON iex.tbl_name = fdup.tbl_name AND iex.col0_name = fdup.col0_name"
    StmtParts(36) = ")"
    StmtParts(37) = "SELECT *"
    StmtParts(38) = "FROM idup AS similar_indices"
    StmtParts(39) = "ORDER BY tbl_name, col0_name, columns"
    
    SimilarIndices = Join(StmtParts, vbNewLine)
End Function

SQLiteSQLEngineInfo

Engine-related code goes in this module.

'@Folder "SQLiteDB.Introspection"
'@ModuleDescription "SQL queries for retrieving information about the engine configuration and available features."
'@PredeclaredId
'@Exposed
'@IgnoreModule ProcedureNotUsed
'''' All methods in this module are class methods and can be safely called on the default instance
'''' @ClassModule
Option Explicit


'@Description "Generates query returning available SQLite collations"
Public Property Get Collations() As String
    Collations = "SELECT * FROM pragma_collation_list AS collations ORDER BY name"
End Property


'@Description "Generates query returning compile options"
Public Property Get CompileOptions() As String
    CompileOptions = "SELECT * FROM pragma_compile_options AS compile_options"
End Property


'@Description "Generates query returning available SQLite functions"
Public Property Get Functions() As String
    Functions = "SELECT * FROM pragma_function_list AS functions ORDER BY name"
End Property


'@Description "Generates query returning available SQLite modules"
Public Property Get Modules() As String
    Modules = "SELECT * FROM pragma_module_list AS modules ORDER BY name"
End Property


'@Description "Generates query returning available SQLite pragmas"
Public Property Get Pragmas() As String
    Pragmas = "SELECT * FROM pragma_pragma_list AS pargmas ORDER BY name"
End Property


'@Description "Generates query returning SQLite version"
Public Property Get Version() As String
    Version = "SELECT sqlite_version() AS version"
End Property

ADOlib.RecordsetToQT

This routine outputs record data from an ADODB.Recordset onto an Excel worksheet via the QueryTable feature. The ADODB.Recordset object is directly provided to the QueryTable constructor keeping the code compact and the process efficient.

'@Description "Outputs Recordset to Excel Worksheet via QueryTable"
Public Sub RecordsetToQT(ByVal AdoRecordset As ADODB.Recordset, ByVal OutputRange As Excel.Range)
Attribute RecordsetToQT.VB_Description = "Outputs Recordset to Excel Worksheet via QueryTable"
    Guard.NullReference AdoRecordset
    Guard.NullReference OutputRange
    
    Dim QTs As Excel.QueryTables
    Set QTs = OutputRange.Worksheet.QueryTables
    
    '''' Cleans up target area before binding the data.
    '''' Provided range reference used to indicate the left column and
    '''' Recordset.Fields.Count determines the width.
    '''' If EntireColumn.Delete method is used, Range object becomes invalid, so
    '''' a textual address must be saved to reset the Range reference.
    '''' However, when multiple QTs are bound to the same worksheet,
    '''' EntireColumn.Delete shifts columns to the left, so the target range
    '''' may not be clear. EntireColumn.Clear clears the contents.
    Dim FieldsCount As Long
    FieldsCount = AdoRecordset.Fields.Count
    Dim QTRangeAddress As String
    QTRangeAddress = OutputRange.Address(External:=True)
    Dim QTRange As Excel.Range
    '@Ignore ImplicitActiveSheetReference
    Set QTRange = Range(QTRangeAddress)
    QTRange.Resize(1, FieldsCount).EntireColumn.Clear
    '@Ignore ImplicitActiveSheetReference
    Set QTRange = Range(QTRangeAddress)
    
    Dim WSQueryTable As Excel.QueryTable
    For Each WSQueryTable In QTs
        WSQueryTable.Delete
    Next WSQueryTable
    
    Dim NamedRange As Excel.Name
    For Each NamedRange In QTRange.Worksheet.Names
        NamedRange.Delete
    Next NamedRange
    
    Set WSQueryTable = QTs.Add(Connection:=AdoRecordset, Destination:=QTRange.Range("A1"))
    With WSQueryTable
        .FieldNames = True
        .RowNumbers = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SaveData = False
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .EnableEditing = True
    End With
    WSQueryTable.Refresh
    QTRange.Worksheet.UsedRange.Rows(1).HorizontalAlignment = xlCenter
End Sub
\$\endgroup\$
2
\$\begingroup\$

Micro-review:

'@IgnoreModule ProcedureNotUsed

I used to sprinkle this around too, however there are a few reasons not to use it:

  1. It indicates your integration tests - if held in the same project files - do not hit this code path, which should be fixed or ignored case-by-case IMO.
  2. The (relatively) new '@EntryPoint annotation is usually a better indication about a public API.
  3. '@IgnoreModule means if you refactor, then different routines may be targeted by this annotation to the ones you had originally intended - that's fine if the module is truly dedicated to just public API and the annotation will always be valid. But sometimes you are ignoring procedures which might not be just API methods.

For example, in SQLiteSQLDbInfo:

Public Sub Init(ByVal Schema As String)
    this.Schema = Schema
End Sub

That could be Friend Sub because it's not public API, and it is vitally important that you do not forget to call this method if you refactor the Create method and accidentally drop the call to Init. ProcedureNotUsed can help with that without having to implement a factory interface.


Also RD lets you define an ignore reason for each '@Ignore[Module] annotation using a colon:

Dim QTRange As Excel.Range
'@Ignore ImplicitActiveSheetReference
Set QTRange = Range(QTRangeAddress)

... could be:

Dim QTRange As Excel.Range
'@Ignore ImplicitActiveSheetReference: QTRangeAddress is a fully qualified external range
Set QTRange = Range(QTRangeAddress)

... that said, if this code made its way into SheetX, then Range implicitly refers to SheetX.Range which fails if QTRange is in SheetY, so better be on the safe side and use the fully qualified Application.Range

So for a workbook with 2 sheets Sheet1 and Sheet2, the following code:

Sub t()
    Debug.Print Range("[Book1]Sheet1!$A$1").Address(external:=True)
End Sub

... fails in Sheet2 since it references Sheet1, but:

Sub t()
    Debug.Print Application.Range("[Book1]Sheet1!$A$1").Address(external:=True)
End Sub

... prints "[Book1]Sheet1!$A$1" as expected

\$\endgroup\$
5
  • \$\begingroup\$ I would go a step further and say that Init should be converted to a property called Schema with the getter scoped as Public and setter scoped as Friend like so Public Property Get Schema() As String Schema = this.Schema End Property Friend Property Let Schema(ByVal value As String ) this.Schema = value End Property along with some Gaurd.NullReference statements. \$\endgroup\$ Aug 18 '21 at 17:06
  • \$\begingroup\$ @rickmanalexander actually, I follow the pattern used by RD examples, where the default factory is called Create. But I extended it with a parametrized constructor called Init. For this reason, I prefer to keep it as a Sub. \$\endgroup\$
    – PChemGuy
    Aug 18 '21 at 18:22
  • \$\begingroup\$ @Greedo I generally agree that bare Range should be avoided. However, please note that I do not use code-behind. This code is in a regular module. In the project repo, there is a workbook SQLiteDBVBALibrary.xls. If you run SQLiteIntropectionExample.Engine, you should get SQLite engine info placed on the worksheet "EngineInfo". And it does not matter which worksheet is active. For that matter, it does not matter, which workbook is active. The information is placed on "EngineInfo". I just verified this behavior in Excel 2002 and Excel 2016. \$\endgroup\$
    – PChemGuy
    Aug 18 '21 at 18:47
  • \$\begingroup\$ @PChemGuy Yeah, I didn't mean to suggest there is a bug, it's more a concern if you refactor later on and put the sheet writing code inside a sheet somewhere, but in your situation that's ofc highly unlikely since you implicitly derive the dest sheet from the Range passed in, not a code-behind. My point was more about "if RD suggests something and you ignore it, make sure to justify that and leave a comment to remind yourself of the justification later on". I didn't know about the :comments till recently and I see you don't use them in other repos so I thought it might be useful to highlight \$\endgroup\$
    – Greedo
    Aug 18 '21 at 19:44
  • \$\begingroup\$ @Greedo I just learned about :comments from your answer. I like this feature and will try to start using it. Actually, I should definitely use the Friend qualifier more often. I often make class members Public just so that I could unit-test them. I think, the Friend qualifier would be more appropriate in such a case. \$\endgroup\$
    – PChemGuy
    Aug 18 '21 at 19:54

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.