Add modular SQL/DB VBA library and TBFC forecast loader
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>
This commit is contained in:
parent
8e383cbf80
commit
3e5a31a5bf
201
Db.cls
Normal file
201
Db.cls
Normal file
@ -0,0 +1,201 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "Db"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
'==========================================================================
|
||||
' Db - a single database connection (modern successor to the ADOp_* helpers
|
||||
' in TheBigOne). Late-bound ADO, so no project reference is required;
|
||||
' import the class and go.
|
||||
'
|
||||
' Defaults to the SQLOLEDB OLE DB provider (built into Windows - zero install,
|
||||
' works for non-admin users), but Provider is settable.
|
||||
'
|
||||
' Dim db As New Db
|
||||
' If db.OpenSqlServer("USMIDSQL01", "fanalysis") Then
|
||||
' If db.Exec(batchSql) Then ... Else MsgBox db.LastError
|
||||
' Dim a As Variant: a = db.Query("SELECT ...") ' 2D, row 1 = headers
|
||||
' db.CloseConn
|
||||
' End If
|
||||
'==========================================================================
|
||||
|
||||
Option Explicit
|
||||
|
||||
Private mConn As Object ' ADODB.Connection (late bound)
|
||||
Private mErr As String
|
||||
Private mProvider As String
|
||||
Private mTimeout As Long
|
||||
Private mRows As Long
|
||||
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
mProvider = "SQLOLEDB"
|
||||
mTimeout = 600
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Terminate()
|
||||
CloseConn
|
||||
Set mConn = Nothing
|
||||
End Sub
|
||||
|
||||
|
||||
'----- properties ---------------------------------------------------------
|
||||
|
||||
Public Property Get Provider() As String
|
||||
Provider = mProvider
|
||||
End Property
|
||||
Public Property Let Provider(ByVal value As String)
|
||||
mProvider = value
|
||||
End Property
|
||||
|
||||
Public Property Get CommandTimeout() As Long
|
||||
CommandTimeout = mTimeout
|
||||
End Property
|
||||
Public Property Let CommandTimeout(ByVal value As Long)
|
||||
mTimeout = value
|
||||
End Property
|
||||
|
||||
Public Property Get LastError() As String
|
||||
LastError = mErr
|
||||
End Property
|
||||
|
||||
Public Property Get RowsAffected() As Long
|
||||
RowsAffected = mRows
|
||||
End Property
|
||||
|
||||
Public Property Get IsOpen() As Boolean
|
||||
IsOpen = (Not mConn Is Nothing)
|
||||
If IsOpen Then IsOpen = (mConn.State <> 0)
|
||||
End Property
|
||||
|
||||
|
||||
'----- open / close -------------------------------------------------------
|
||||
|
||||
' Open a SQL Server connection. Integrated (Windows) security by default.
|
||||
Public Function OpenSqlServer(ByVal server As String, _
|
||||
Optional ByVal database As String = "", _
|
||||
Optional ByVal integratedSecurity As Boolean = True, _
|
||||
Optional ByVal user As String = "", _
|
||||
Optional ByVal password As String = "") As Boolean
|
||||
Dim cs As String
|
||||
cs = "Provider=" & mProvider & ";Data Source=" & server & ";"
|
||||
If Len(database) > 0 Then cs = cs & "Initial Catalog=" & database & ";"
|
||||
If integratedSecurity Then
|
||||
cs = cs & "Integrated Security=SSPI;"
|
||||
Else
|
||||
cs = cs & "User ID=" & user & ";Password=" & password & ";"
|
||||
End If
|
||||
OpenSqlServer = OpenConnString(cs)
|
||||
End Function
|
||||
|
||||
' Open with any provided connection string.
|
||||
Public Function OpenConnString(ByVal connString As String) As Boolean
|
||||
On Error GoTo fail
|
||||
mErr = ""
|
||||
If mConn Is Nothing Then Set mConn = CreateObject("ADODB.Connection")
|
||||
If mConn.State <> 0 Then mConn.Close
|
||||
mConn.Open connString
|
||||
OpenConnString = True
|
||||
Exit Function
|
||||
fail:
|
||||
mErr = "Open failed: " & Err.Number & " - " & Err.Description
|
||||
OpenConnString = False
|
||||
End Function
|
||||
|
||||
Public Sub CloseConn()
|
||||
On Error Resume Next
|
||||
If Not mConn Is Nothing Then
|
||||
If mConn.State <> 0 Then mConn.Close
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
'----- execute / query ----------------------------------------------------
|
||||
|
||||
' Run a statement or multi-statement batch. RowsAffected is set after.
|
||||
Public Function Exec(ByVal sql As String) As Boolean
|
||||
On Error GoTo fail
|
||||
mErr = "": mRows = 0
|
||||
If Not IsOpen Then
|
||||
mErr = "Connection is not open."
|
||||
Exec = False
|
||||
Exit Function
|
||||
End If
|
||||
mConn.CommandTimeout = mTimeout
|
||||
Dim affected As Variant
|
||||
mConn.Execute sql, affected
|
||||
If Not IsEmpty(affected) Then mRows = CLng(affected)
|
||||
Exec = True
|
||||
Exit Function
|
||||
fail:
|
||||
mErr = "Exec failed: " & Err.Number & " - " & Err.Description
|
||||
Exec = False
|
||||
End Function
|
||||
|
||||
' Run a query and return a 2D Variant array (1-based). Row 1 = headers when
|
||||
' includeHeaders. Returns Empty on error or no columns; check LastError.
|
||||
Public Function Query(ByVal sql As String, Optional ByVal includeHeaders As Boolean = True) As Variant
|
||||
On Error GoTo fail
|
||||
mErr = ""
|
||||
If Not IsOpen Then
|
||||
mErr = "Connection is not open."
|
||||
Query = Empty
|
||||
Exit Function
|
||||
End If
|
||||
mConn.CommandTimeout = mTimeout
|
||||
|
||||
Dim rs As Object
|
||||
Set rs = mConn.Execute(sql)
|
||||
Query = RecordsetToArray(rs, includeHeaders)
|
||||
On Error Resume Next
|
||||
rs.Close
|
||||
Exit Function
|
||||
fail:
|
||||
mErr = "Query failed: " & Err.Number & " - " & Err.Description
|
||||
Query = Empty
|
||||
End Function
|
||||
|
||||
|
||||
'----- helpers ------------------------------------------------------------
|
||||
|
||||
Private Function RecordsetToArray(ByVal rs As Object, ByVal includeHeaders As Boolean) As Variant
|
||||
Dim nCols As Long, i As Long, j As Long
|
||||
nCols = rs.Fields.Count
|
||||
If nCols = 0 Then
|
||||
RecordsetToArray = Empty
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim block As Variant, nData As Long
|
||||
If Not (rs.BOF And rs.EOF) Then
|
||||
block = rs.GetRows ' 0-based (col, row)
|
||||
nData = UBound(block, 2) - LBound(block, 2) + 1
|
||||
End If
|
||||
|
||||
Dim hdrOff As Long
|
||||
hdrOff = IIf(includeHeaders, 1, 0)
|
||||
|
||||
If nData + hdrOff = 0 Then
|
||||
RecordsetToArray = Empty
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim out() As Variant
|
||||
ReDim out(1 To nData + hdrOff, 1 To nCols)
|
||||
If includeHeaders Then
|
||||
For j = 0 To nCols - 1
|
||||
out(1, j + 1) = rs.Fields(j).Name
|
||||
Next j
|
||||
End If
|
||||
For i = 0 To nData - 1
|
||||
For j = 0 To nCols - 1
|
||||
out(i + 1 + hdrOff, j + 1) = block(j, i)
|
||||
Next j
|
||||
Next i
|
||||
|
||||
RecordsetToArray = out
|
||||
End Function
|
||||
239
Sql.bas
Normal file
239
Sql.bas
Normal file
@ -0,0 +1,239 @@
|
||||
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
|
||||
93
TBFCLoad.bas
Normal file
93
TBFCLoad.bas
Normal file
@ -0,0 +1,93 @@
|
||||
Attribute VB_Name = "TBFCLoad"
|
||||
'==========================================================================
|
||||
' TBFCLoad - load the "Upload" tab into fanalysis.GS.TBFC on SQL Server.
|
||||
'
|
||||
' Entry point: Load_TBFC (assign this to a button)
|
||||
'
|
||||
' A thin caller over the generic Sql (text generation) and Db (connection)
|
||||
' objects. The forecast-specific choices live here; everything reusable lives
|
||||
' in Sql/Db:
|
||||
' - types inferred from the Excel cells (Sql.InferKinds): Date->DATE,
|
||||
' numeric->DECIMAL(18,2), text->NVARCHAR(100)
|
||||
' - auto-create fanalysis.GS.TBFC on first run
|
||||
' - replace-by-Source: delete rows for the Source(s) on the tab, then insert
|
||||
' - one T-SQL batch over the SQLOLEDB connection (zero install, integrated auth)
|
||||
'==========================================================================
|
||||
|
||||
Option Explicit
|
||||
|
||||
Private Const SHEET_NAME As String = "Upload"
|
||||
Private Const HDR_ROW As Long = 8
|
||||
Private Const FIRST_COL As Long = 2 ' B
|
||||
Private Const LAST_COL As Long = 11 ' K
|
||||
Private Const FQ As String = "[fanalysis].[GS].[TBFC]"
|
||||
Private Const SVR As String = "USMIDSQL01"
|
||||
Private Const DBNAME As String = "fanalysis"
|
||||
Private Const AMT_SCALE As Long = 2
|
||||
Private Const TEXT_LEN As Long = 100
|
||||
|
||||
|
||||
Sub Load_TBFC()
|
||||
|
||||
Dim ws As Worksheet
|
||||
Dim arr As Variant
|
||||
Dim kinds As Variant
|
||||
Dim lastRow As Long
|
||||
Dim srcCol As Long
|
||||
Dim srcList As String
|
||||
Dim batch As String
|
||||
Dim db As Db
|
||||
|
||||
'-- locate the tab --------------------------------------------------
|
||||
On Error Resume Next
|
||||
Set ws = ThisWorkbook.Worksheets(SHEET_NAME)
|
||||
On Error GoTo 0
|
||||
If ws Is Nothing Then
|
||||
MsgBox "Sheet '" & SHEET_NAME & "' not found in this workbook.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
lastRow = ws.Cells(ws.Rows.Count, FIRST_COL).End(xlUp).Row
|
||||
If lastRow <= HDR_ROW Then
|
||||
MsgBox "No data rows found below the header on '" & SHEET_NAME & "'.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'-- read header + data (typed Variant array; row 1 = header) --------
|
||||
arr = ws.Range(ws.Cells(HDR_ROW, FIRST_COL), ws.Cells(lastRow, LAST_COL)).Value
|
||||
kinds = Sql.InferKinds(arr)
|
||||
|
||||
srcCol = Sql.ColIndex(arr, "Source")
|
||||
If srcCol = 0 Then
|
||||
MsgBox "No 'Source' column found on the Upload tab; cannot replace by Source.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
srcList = Sql.InList(Sql.DistinctText(arr, srcCol), dlSqlServer)
|
||||
|
||||
'-- compose the batch ----------------------------------------------
|
||||
batch = "SET NOCOUNT ON;" & vbCrLf
|
||||
batch = batch & Sql.CreateTableIfMissing(FQ, arr, dlSqlServer, kinds, AMT_SCALE, TEXT_LEN) & ";" & vbCrLf
|
||||
If Len(srcList) > 0 Then
|
||||
batch = batch & "DELETE FROM " & FQ & " WHERE " & _
|
||||
Sql.BracketId("Source", dlSqlServer) & " IN (" & srcList & ");" & vbCrLf
|
||||
End If
|
||||
batch = batch & Sql.InsertSelectValues(FQ, arr, dlSqlServer, kinds, TEXT_LEN) & ";"
|
||||
|
||||
'-- execute ---------------------------------------------------------
|
||||
Set db = New Db
|
||||
If Not db.OpenSqlServer(SVR, DBNAME) Then
|
||||
MsgBox "Connection FAILED:" & vbCrLf & vbCrLf & db.LastError, vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If db.Exec(batch) Then
|
||||
MsgBox "TBFC load complete." & vbCrLf & _
|
||||
"Inserted " & (UBound(arr, 1) - 1) & " row(s)." & vbCrLf & _
|
||||
"Source(s) replaced: " & srcList, vbInformation
|
||||
Else
|
||||
MsgBox "TBFC load FAILED:" & vbCrLf & vbCrLf & db.LastError, vbExclamation
|
||||
End If
|
||||
|
||||
db.CloseConn
|
||||
|
||||
End Sub
|
||||
150
load_tbfc.py
Normal file
150
load_tbfc.py
Normal file
@ -0,0 +1,150 @@
|
||||
#!/usr/bin/env python3
|
||||
"""
|
||||
Load the "Upload" tab of a forecast workbook into fanalysis.GS.TBFC (SQL Server).
|
||||
|
||||
Usage: python load_tbfc.py "<path to .xlsx>"
|
||||
|
||||
- Reads the saved workbook from disk (Excel need not be open).
|
||||
- Infers a SQL type per column from the Excel cell types:
|
||||
date cells -> DATE
|
||||
numeric cells -> DECIMAL(18,2) (rounded half-up)
|
||||
else (text) -> NVARCHAR(100)
|
||||
- Creates fanalysis.GS.TBFC on first run if it doesn't exist.
|
||||
- Replace-by-Source: deletes existing rows whose [Source] matches the
|
||||
Source value(s) in this upload, then inserts the new rows. Other
|
||||
scenarios already in the table are left untouched.
|
||||
- Integrated (Windows) auth to USMIDSQL01; the whole load is one transaction.
|
||||
"""
|
||||
|
||||
import sys
|
||||
import datetime
|
||||
from decimal import Decimal, ROUND_HALF_UP
|
||||
|
||||
import openpyxl
|
||||
import pyodbc
|
||||
|
||||
SERVER, DATABASE, SCHEMA, TABLE = "USMIDSQL01", "fanalysis", "GS", "TBFC"
|
||||
SHEET = "Upload"
|
||||
HEADER_ROW = 8 # data starts on HEADER_ROW + 1
|
||||
FIRST_COL = 2 # column B
|
||||
LAST_COL = 11 # column K
|
||||
NVARCHAR_LEN = 100
|
||||
AMOUNT_DP = 2 # decimal places for numeric columns
|
||||
|
||||
FQ_TABLE = f"[{DATABASE}].[{SCHEMA}].[{TABLE}]"
|
||||
|
||||
|
||||
def pick_driver():
|
||||
prefer = ["ODBC Driver 18 for SQL Server", "ODBC Driver 17 for SQL Server",
|
||||
"SQL Server Native Client 11.0", "SQL Server"]
|
||||
avail = pyodbc.drivers()
|
||||
for d in prefer:
|
||||
if d in avail:
|
||||
return d
|
||||
if avail:
|
||||
return avail[-1]
|
||||
raise RuntimeError("No ODBC driver for SQL Server found.")
|
||||
|
||||
|
||||
def connect():
|
||||
driver = pick_driver()
|
||||
cs = f"Driver={{{driver}}};Server={SERVER};Database={DATABASE};Trusted_Connection=yes;"
|
||||
if "18" in driver: # driver 18 encrypts by default
|
||||
cs += "Encrypt=no;TrustServerCertificate=yes;"
|
||||
return pyodbc.connect(cs, autocommit=False)
|
||||
|
||||
|
||||
def read_upload(path):
|
||||
wb = openpyxl.load_workbook(path, read_only=True, data_only=True)
|
||||
if SHEET not in wb.sheetnames:
|
||||
raise RuntimeError(f'Sheet "{SHEET}" not found. Tabs: {wb.sheetnames}')
|
||||
ws = wb[SHEET]
|
||||
headers = [ws.cell(HEADER_ROW, c).value for c in range(FIRST_COL, LAST_COL + 1)]
|
||||
rows = []
|
||||
for r in range(HEADER_ROW + 1, ws.max_row + 1):
|
||||
vals = [ws.cell(r, c).value for c in range(FIRST_COL, LAST_COL + 1)]
|
||||
if all(v is None or (isinstance(v, str) and not v.strip()) for v in vals):
|
||||
continue # skip blank rows
|
||||
rows.append(vals)
|
||||
wb.close()
|
||||
return headers, rows
|
||||
|
||||
|
||||
def infer_types(headers, rows):
|
||||
"""Return [(sql_type, kind)] per column; kind in {date, num, text}."""
|
||||
out = []
|
||||
for j in range(len(headers)):
|
||||
vals = [row[j] for row in rows if row[j] is not None]
|
||||
if vals and all(isinstance(v, (datetime.datetime, datetime.date)) for v in vals):
|
||||
out.append(("DATE", "date"))
|
||||
elif vals and all(isinstance(v, (int, float)) and not isinstance(v, bool) for v in vals):
|
||||
out.append((f"DECIMAL(18,{AMOUNT_DP})", "num"))
|
||||
else:
|
||||
out.append((f"NVARCHAR({NVARCHAR_LEN})", "text"))
|
||||
return out
|
||||
|
||||
|
||||
def coerce(value, kind):
|
||||
if value is None:
|
||||
return None
|
||||
if kind == "date":
|
||||
return value.date() if isinstance(value, datetime.datetime) else value
|
||||
if kind == "num":
|
||||
return Decimal(str(value)).quantize(Decimal(10) ** -AMOUNT_DP, rounding=ROUND_HALF_UP)
|
||||
return str(value).strip()[:NVARCHAR_LEN]
|
||||
|
||||
|
||||
def main():
|
||||
if len(sys.argv) < 2:
|
||||
print("usage: python load_tbfc.py <workbook.xlsx>", file=sys.stderr)
|
||||
return 2
|
||||
path = sys.argv[1]
|
||||
|
||||
headers, rows = read_upload(path)
|
||||
if not rows:
|
||||
print("No data rows found on the Upload tab.", file=sys.stderr)
|
||||
return 1
|
||||
types = infer_types(headers, rows)
|
||||
|
||||
if "Source" not in headers:
|
||||
raise RuntimeError(f'No "Source" column found. Headers: {headers}')
|
||||
src_idx = headers.index("Source")
|
||||
|
||||
data = [[coerce(v, types[j][1]) for j, v in enumerate(row)] for row in rows]
|
||||
sources = sorted({row[src_idx] for row in data if row[src_idx] is not None})
|
||||
|
||||
cols_ddl = ",\n ".join(f"[{h}] {t}" for h, (t, _) in zip(headers, types))
|
||||
create_sql = (f"IF OBJECT_ID('{DATABASE}.{SCHEMA}.{TABLE}','U') IS NULL\n"
|
||||
f"CREATE TABLE {FQ_TABLE} (\n {cols_ddl}\n);")
|
||||
col_list = ", ".join(f"[{h}]" for h in headers)
|
||||
insert_sql = f"INSERT INTO {FQ_TABLE} ({col_list}) VALUES ({', '.join('?' for _ in headers)})"
|
||||
|
||||
cn = connect()
|
||||
cur = cn.cursor()
|
||||
try:
|
||||
cur.execute(create_sql)
|
||||
deleted = 0
|
||||
if sources:
|
||||
marks = ", ".join("?" for _ in sources)
|
||||
cur.execute(f"DELETE FROM {FQ_TABLE} WHERE [Source] IN ({marks})", *sources)
|
||||
deleted = cur.rowcount
|
||||
cur.fast_executemany = True
|
||||
cur.executemany(insert_sql, data)
|
||||
cn.commit()
|
||||
except Exception:
|
||||
cn.rollback()
|
||||
raise
|
||||
finally:
|
||||
cur.close()
|
||||
cn.close()
|
||||
|
||||
print("TBFC load complete.")
|
||||
print(f" Source(s): {', '.join(sources)}")
|
||||
print(f" Deleted: {deleted} existing row(s)")
|
||||
print(f" Inserted: {len(data)} row(s)")
|
||||
print(" Schema: " + ", ".join(f"{h} {t}" for h, (t, _) in zip(headers, types)))
|
||||
return 0
|
||||
|
||||
|
||||
if __name__ == "__main__":
|
||||
sys.exit(main())
|
||||
Loading…
Reference in New Issue
Block a user