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>
94 lines
3.5 KiB
QBasic
94 lines
3.5 KiB
QBasic
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
|