Paul Trowbridge
3e5a31a5bf
Start a modern, modular successor to TheBigOne (side-by-side; TheBigOne untouched): - Sql.bas: stateless SQL-text generation from a 2D Variant array (header in row 1). Type inference from Excel cell VarType, dialect-aware identifier quoting/literals, VALUES batch + INSERT...SELECT, and CreateTableIfMissing. Successor to the SQLp_* helpers. - Db.cls: single connection object, late-bound ADO (no reference needed), SQLOLEDB by default (zero-install / non-admin friendly). Open/Exec/Query with structured LastError. Successor to the ADOp_* helpers. - TBFCLoad.bas: thin caller that loads the "Upload" tab into fanalysis.GS.TBFC (auto-create, replace-by-Source). Tested vs USMIDSQL01. - load_tbfc.py: equivalent Python loader kept as a power-user alternative. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
240 lines
9.1 KiB
QBasic
240 lines
9.1 KiB
QBasic
Attribute VB_Name = "Sql"
|
|
'==========================================================================
|
|
' Sql - generate SQL text from a 2D array (modern successor to SQLp_* in
|
|
' TheBigOne). Stateless, no connection, no ORM - it just writes SQL.
|
|
'
|
|
' Convention: callers pass a 2D Variant array whose FIRST ROW is the header
|
|
' (exactly what Range.Value returns for a block with a header row). Column
|
|
' SQL types are inferred from the Excel cell VarType per column:
|
|
' date cells -> DATE
|
|
' numeric cells -> DECIMAL(18, scale)
|
|
' everything else (incl. text-stored codes) -> N/VARCHAR(len)
|
|
'
|
|
' Final insert shape is INSERT ... SELECT * FROM (VALUES ...) x(cols) - a
|
|
' derived table, so SQL Server's 1000-row VALUES limit does not apply.
|
|
'==========================================================================
|
|
|
|
Option Explicit
|
|
|
|
Public Enum SqlDialect
|
|
dlSqlServer = 0
|
|
dlPostgres = 1
|
|
End Enum
|
|
|
|
Public Enum ColKind
|
|
ckText = 0
|
|
ckNumber = 1
|
|
ckDate = 2
|
|
End Enum
|
|
|
|
|
|
'----- low-level building blocks ------------------------------------------
|
|
|
|
' Quote an identifier for the dialect, escaping the close-quote char.
|
|
Public Function BracketId(ByVal name As String, ByVal dialect As SqlDialect) As String
|
|
If dialect = dlSqlServer Then
|
|
BracketId = "[" & Replace(name, "]", "]]") & "]"
|
|
Else
|
|
BracketId = """" & Replace(name, """", """""") & """"
|
|
End If
|
|
End Function
|
|
|
|
' One SQL literal for a value of the given kind. maxLen > 0 truncates text.
|
|
Public Function Literal(ByVal v As Variant, ByVal kind As ColKind, _
|
|
ByVal dialect As SqlDialect, Optional ByVal maxLen As Long = 0) As String
|
|
If IsEmpty(v) Or IsNull(v) Or IsError(v) Then
|
|
Literal = "NULL"
|
|
Exit Function
|
|
End If
|
|
|
|
Select Case kind
|
|
Case ckDate
|
|
If IsDate(v) Then
|
|
Literal = "'" & Format$(CDate(v), "yyyy-mm-dd") & "'"
|
|
Else
|
|
Literal = "NULL"
|
|
End If
|
|
|
|
Case ckNumber
|
|
If Not IsNumeric(v) Or Len(Trim$(CStr(v))) = 0 Then
|
|
Literal = "NULL"
|
|
Else
|
|
' Str$ is locale-invariant ('.' decimal, leading space for sign)
|
|
Literal = Trim$(Str$(v))
|
|
End If
|
|
|
|
Case Else ' ckText
|
|
Dim s As String
|
|
s = CStr(v)
|
|
If maxLen > 0 And Len(s) > maxLen Then s = Left$(s, maxLen)
|
|
Literal = "'" & Replace(s, "'", "''") & "'"
|
|
End Select
|
|
End Function
|
|
|
|
' Map a column kind to a SQL type. DECIMAL is valid in both dialects.
|
|
Public Function SqlType(ByVal kind As ColKind, ByVal dialect As SqlDialect, _
|
|
Optional ByVal numScale As Long = 2, Optional ByVal textLen As Long = 100) As String
|
|
Select Case kind
|
|
Case ckDate
|
|
SqlType = "DATE"
|
|
Case ckNumber
|
|
SqlType = "DECIMAL(18," & numScale & ")"
|
|
Case Else
|
|
If dialect = dlSqlServer Then
|
|
SqlType = "NVARCHAR(" & textLen & ")"
|
|
Else
|
|
SqlType = "VARCHAR(" & textLen & ")"
|
|
End If
|
|
End Select
|
|
End Function
|
|
|
|
|
|
'----- inference & lookups ------------------------------------------------
|
|
|
|
' Infer a ColKind per column from the first non-empty data cell.
|
|
' Returns a Long() indexed to match the data's column bounds.
|
|
Public Function InferKinds(ByVal data As Variant) As Variant
|
|
Dim rLo As Long, rHi As Long, cLo As Long, cHi As Long, i As Long, j As Long
|
|
rLo = LBound(data, 1): rHi = UBound(data, 1)
|
|
cLo = LBound(data, 2): cHi = UBound(data, 2)
|
|
|
|
Dim k() As Long
|
|
ReDim k(cLo To cHi)
|
|
For j = cLo To cHi
|
|
k(j) = ckText
|
|
For i = rLo + 1 To rHi ' skip header row
|
|
If Not IsEmpty(data(i, j)) Then
|
|
If Not IsError(data(i, j)) Then
|
|
Select Case VarType(data(i, j))
|
|
Case vbDate
|
|
k(j) = ckDate
|
|
Case vbDouble, vbSingle, vbInteger, vbLong, vbCurrency, vbDecimal
|
|
k(j) = ckNumber
|
|
Case Else
|
|
k(j) = ckText
|
|
End Select
|
|
Exit For
|
|
End If
|
|
End If
|
|
Next i
|
|
Next j
|
|
InferKinds = k
|
|
End Function
|
|
|
|
' 1-based-or-whatever column index of a header by name; 0 if not found.
|
|
Public Function ColIndex(ByVal data As Variant, ByVal headerName As String) As Long
|
|
Dim cLo As Long, cHi As Long, j As Long, hdr As Long
|
|
hdr = LBound(data, 1)
|
|
cLo = LBound(data, 2): cHi = UBound(data, 2)
|
|
For j = cLo To cHi
|
|
If StrComp(Trim$(CStr(data(hdr, j))), headerName, vbTextCompare) = 0 Then
|
|
ColIndex = j
|
|
Exit Function
|
|
End If
|
|
Next j
|
|
ColIndex = 0
|
|
End Function
|
|
|
|
' Distinct non-empty text values in a column (skips header). 0-based array.
|
|
Public Function DistinctText(ByVal data As Variant, ByVal colIndex As Long) As Variant
|
|
Dim d As Object
|
|
Set d = CreateObject("Scripting.Dictionary")
|
|
d.CompareMode = vbTextCompare
|
|
Dim rLo As Long, rHi As Long, i As Long, s As String
|
|
rLo = LBound(data, 1): rHi = UBound(data, 1)
|
|
For i = rLo + 1 To rHi
|
|
If Not IsEmpty(data(i, colIndex)) And Not IsError(data(i, colIndex)) Then
|
|
s = Trim$(CStr(data(i, colIndex)))
|
|
If Len(s) > 0 Then If Not d.Exists(s) Then d.Add s, True
|
|
End If
|
|
Next i
|
|
DistinctText = d.Keys
|
|
End Function
|
|
|
|
|
|
'----- composite generators -----------------------------------------------
|
|
|
|
' Comma list of bracketed header names, e.g. [Date], [Account GL], ...
|
|
Public Function ColumnList(ByVal data As Variant, ByVal dialect As SqlDialect) As String
|
|
Dim cLo As Long, cHi As Long, j As Long, hdr As Long
|
|
hdr = LBound(data, 1)
|
|
cLo = LBound(data, 2): cHi = UBound(data, 2)
|
|
Dim parts() As String
|
|
ReDim parts(cLo To cHi)
|
|
For j = cLo To cHi
|
|
parts(j) = BracketId(CStr(data(hdr, j)), dialect)
|
|
Next j
|
|
ColumnList = Join(parts, ", ")
|
|
End Function
|
|
|
|
' Quote a 1D array of values as a comma list for an IN (...) clause (text).
|
|
Public Function InList(ByVal values As Variant, ByVal dialect As SqlDialect) As String
|
|
If IsEmpty(values) Then Exit Function
|
|
Dim lo As Long, hi As Long, i As Long
|
|
lo = LBound(values): hi = UBound(values)
|
|
If hi < lo Then Exit Function
|
|
Dim parts() As String
|
|
ReDim parts(lo To hi)
|
|
For i = lo To hi
|
|
parts(i) = "'" & Replace(CStr(values(i)), "'", "''") & "'"
|
|
Next i
|
|
InList = Join(parts, ", ")
|
|
End Function
|
|
|
|
' SELECT * FROM (VALUES (..),(..)) x([col],[col]) over the data rows.
|
|
Public Function ValuesSelect(ByVal data As Variant, ByVal dialect As SqlDialect, _
|
|
Optional ByRef kinds As Variant, Optional ByVal textLen As Long = 0) As String
|
|
Dim rLo As Long, rHi As Long, cLo As Long, cHi As Long, i As Long, j As Long, r As Long
|
|
rLo = LBound(data, 1): rHi = UBound(data, 1)
|
|
cLo = LBound(data, 2): cHi = UBound(data, 2)
|
|
If IsMissing(kinds) Then kinds = InferKinds(data)
|
|
|
|
Dim rows() As String, cells() As String
|
|
ReDim rows(1 To rHi - rLo) ' data rows = total - header
|
|
ReDim cells(cLo To cHi)
|
|
For i = rLo + 1 To rHi
|
|
For j = cLo To cHi
|
|
cells(j) = Literal(data(i, j), kinds(j), dialect, textLen)
|
|
Next j
|
|
r = r + 1
|
|
rows(r) = "(" & Join(cells, ",") & ")"
|
|
Next i
|
|
|
|
ValuesSelect = "SELECT * FROM (VALUES" & vbCrLf & _
|
|
Join(rows, "," & vbCrLf) & vbCrLf & _
|
|
") x (" & ColumnList(data, dialect) & ")"
|
|
End Function
|
|
|
|
' Full INSERT INTO <fq> (cols) SELECT * FROM (VALUES ...) x(cols).
|
|
Public Function InsertSelectValues(ByVal fq As String, ByVal data As Variant, ByVal dialect As SqlDialect, _
|
|
Optional ByRef kinds As Variant, Optional ByVal textLen As Long = 0) As String
|
|
If IsMissing(kinds) Then kinds = InferKinds(data)
|
|
InsertSelectValues = "INSERT INTO " & fq & " (" & ColumnList(data, dialect) & ")" & vbCrLf & _
|
|
ValuesSelect(data, dialect, kinds, textLen)
|
|
End Function
|
|
|
|
' DDL that creates <fq> only if it doesn't already exist, with inferred types.
|
|
Public Function CreateTableIfMissing(ByVal fq As String, ByVal data As Variant, ByVal dialect As SqlDialect, _
|
|
Optional ByRef kinds As Variant, _
|
|
Optional ByVal numScale As Long = 2, Optional ByVal textLen As Long = 100) As String
|
|
If IsMissing(kinds) Then kinds = InferKinds(data)
|
|
Dim cLo As Long, cHi As Long, j As Long, hdr As Long
|
|
hdr = LBound(data, 1)
|
|
cLo = LBound(data, 2): cHi = UBound(data, 2)
|
|
Dim parts() As String
|
|
ReDim parts(cLo To cHi)
|
|
For j = cLo To cHi
|
|
parts(j) = BracketId(CStr(data(hdr, j)), dialect) & " " & SqlType(kinds(j), dialect, numScale, textLen)
|
|
Next j
|
|
Dim ddl As String
|
|
ddl = Join(parts, ", ")
|
|
|
|
If dialect = dlSqlServer Then
|
|
Dim plain As String
|
|
plain = Replace(Replace(fq, "[", ""), "]", "")
|
|
CreateTableIfMissing = "IF OBJECT_ID('" & plain & "','U') IS NULL CREATE TABLE " & fq & " (" & ddl & ")"
|
|
Else
|
|
CreateTableIfMissing = "CREATE TABLE IF NOT EXISTS " & fq & " (" & ddl & ")"
|
|
End If
|
|
End Function
|