work on target groups
This commit is contained in:
parent
e1053de60a
commit
232c0a07dd
@ -404,14 +404,14 @@ Sub BuildPricingPath()
|
||||
End If
|
||||
|
||||
' === 1. Call Postgres NEW FUNCTION ===
|
||||
sql = "SELECT attr, ds, chan, tier, vol, agg FROM pricequote.build_pricing_path(" & _
|
||||
sql = "SELECT stlc, ds, chan, tier, vol, price FROM pricequote.build_pricing_path(" & _
|
||||
"'" & Replace(optionsJSON, "'", "''") & "') WHERE lastflag"
|
||||
|
||||
res = x.ADOp_SelectS(0, sql, True, 50000, True, PostgreSQLODBC, _
|
||||
"usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
|
||||
|
||||
ws.Range("V:ZZ").ClearContents
|
||||
Call x.SHTp_Dump(res, ws.Name, 1, 22, False, True, 5)
|
||||
Call x.SHTp_Dump(res, ws.Name, 1, 21, False, True, 5)
|
||||
|
||||
|
||||
Cleanup:
|
||||
@ -560,3 +560,73 @@ HandleError:
|
||||
End Sub
|
||||
|
||||
|
||||
Sub LoadTargetPrices()
|
||||
|
||||
Const COL_FOLDER As Long = 1
|
||||
Const ROW_FOLDER As Long = 2
|
||||
Const COL_REGEX As Long = 1
|
||||
Const ROW_REGEX As Long = 5
|
||||
|
||||
Dim ws As Worksheet
|
||||
Dim res() As String
|
||||
Dim onfile() As String
|
||||
Dim csvTable As Variant
|
||||
Dim optionsJSON As String
|
||||
Dim pricegroup As String
|
||||
Dim folder As String
|
||||
Dim sql As String
|
||||
Dim fpath As String
|
||||
Dim i As Long
|
||||
Dim x As New TheBigOne
|
||||
Dim fso As Object
|
||||
|
||||
On Error GoTo HandleError
|
||||
|
||||
Set ws = ActiveSheet
|
||||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||||
|
||||
' === Read regex and folder ===
|
||||
pricegroup = trim(ws.Cells(ROW_REGEX, COL_REGEX).value)
|
||||
folder = trim(ws.Cells(ROW_FOLDER, COL_FOLDER).value)
|
||||
|
||||
If folder = "" Then
|
||||
MsgBox "Error: No folder name in A2.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' === Build CSV path ===
|
||||
fpath = Sheets("env").Range("B1").value
|
||||
If Right(fpath, 1) <> "\" Then fpath = fpath & "\"
|
||||
fpath = fpath & folder & "\options.csv"
|
||||
|
||||
' === Build options JSON ===
|
||||
If fso.FileExists(fpath) Then
|
||||
onfile = x.FILEp_GetCSV(fpath)
|
||||
csvTable = onfile
|
||||
optionsJSON = x.json_from_table(csvTable, "", True)
|
||||
Else
|
||||
optionsJSON = "[]"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' === 1. Call Postgres NEW FUNCTION ===
|
||||
sql = "CALL pricequote.load_target_prices($$" & optionsJSON & "$$::jsonb);"
|
||||
|
||||
If Not x.ADOp_Exec(0, sql, 10, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm") Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
GoTo Cleanup
|
||||
End If
|
||||
|
||||
MsgBox ("Targets Loaded")
|
||||
|
||||
Cleanup:
|
||||
On Error Resume Next
|
||||
Call x.ADOp_CloseCon(0)
|
||||
Exit Sub
|
||||
|
||||
HandleError:
|
||||
MsgBox "Error in BuildPricingPath: " & Err.Description, vbExclamation
|
||||
Resume Cleanup
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
120
TheBigOne.cls
120
TheBigOne.cls
@ -2363,68 +2363,120 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, tri
|
||||
End Function
|
||||
|
||||
Public Function json_from_table(ByRef tbl As Variant, ByRef array_label As String, Optional strip_braces As Boolean) As String
|
||||
|
||||
|
||||
Dim ajson As String
|
||||
Dim json As String
|
||||
Dim r As Integer
|
||||
Dim c As Integer
|
||||
Dim r As Long
|
||||
Dim c As Long
|
||||
Dim needs_comma As Boolean
|
||||
Dim needs_braces As Integer
|
||||
|
||||
Dim needs_braces As Long
|
||||
Dim header As String
|
||||
Dim value As String
|
||||
|
||||
needs_comma = False
|
||||
needs_braces = 0
|
||||
ajson = ""
|
||||
|
||||
|
||||
For r = LBound(tbl, 1) + 1 To UBound(tbl, 1)
|
||||
json = ""
|
||||
needs_comma = False
|
||||
needs_braces = 0
|
||||
|
||||
For c = LBound(tbl, 2) To UBound(tbl, 2)
|
||||
If tbl(r, c) <> "" Then
|
||||
needs_braces = needs_braces + 1
|
||||
header = tbl(LBound(tbl, 1), c)
|
||||
value = tbl(r, c)
|
||||
|
||||
If header <> "" And value <> "" Then
|
||||
If needs_comma Then json = json & ","
|
||||
needs_comma = True
|
||||
If IsNumeric(tbl(r, c)) Then
|
||||
json = json & Chr(34) & tbl(LBound(tbl, 2), c) & Chr(34) & ":" & tbl(r, c)
|
||||
|
||||
json = json & """" & EscapeJSONString(header) & """:"
|
||||
|
||||
If IsNumeric(value) And Not Left(value, 1) = "0" Then
|
||||
json = json & value
|
||||
ElseIf Left(value, 1) = "{" Or Left(value, 1) = "[" Then
|
||||
' Already a JSON object or array
|
||||
json = json & value
|
||||
Else
|
||||
If Left(tbl(r, c), 1) = "{" Or Left(tbl(r, c), 1) = "[" Then
|
||||
json = json & Chr(34) & tbl(LBound(tbl, 2), c) & Chr(34) & ":" & tbl(r, c)
|
||||
Else
|
||||
json = json & Chr(34) & tbl(LBound(tbl, 2), c) & Chr(34) & ":" & Chr(34) & Replace(tbl(r, c), Chr(34), Chr(34) & Chr(34)) & Chr(34)
|
||||
End If
|
||||
json = json & """" & EscapeJSONString(value) & """"
|
||||
End If
|
||||
End If
|
||||
Next c
|
||||
If needs_braces > 0 Then json = "{" & json & "}"
|
||||
needs_comma = False
|
||||
needs_braces = 0
|
||||
If r > LBound(tbl, 1) + 1 Then
|
||||
ajson = ajson & "," & json
|
||||
Else
|
||||
ajson = json
|
||||
|
||||
If json <> "" Then
|
||||
json = "{" & json & "}"
|
||||
If ajson = "" Then
|
||||
ajson = json
|
||||
Else
|
||||
ajson = ajson & "," & json
|
||||
End If
|
||||
End If
|
||||
json = ""
|
||||
Next r
|
||||
|
||||
'if theres more the one record, include brackets for array
|
||||
'if an array_label is given give the array a key and the array become the value
|
||||
'then if the array is labeled with a key it should have braces unless specified otherwise
|
||||
If r > LBound(tbl, 1) + 2 Then
|
||||
|
||||
' If more than one record, make an array
|
||||
If InStr(ajson, "},{") > 0 Then
|
||||
ajson = "[" & ajson & "]"
|
||||
If array_label <> "" Then
|
||||
ajson = """" & array_label & """:" & ajson
|
||||
ajson = """" & EscapeJSONString(array_label) & """:" & ajson
|
||||
If Not strip_braces Then
|
||||
ajson = "{" & ajson & "}"
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
If strip_braces Then
|
||||
ajson = Mid(ajson, 2, Len(ajson) - 2)
|
||||
If array_label <> "" Then
|
||||
If Not strip_braces Then
|
||||
ajson = "{" & """" & EscapeJSONString(array_label) & """:" & ajson & "}"
|
||||
End If
|
||||
Else
|
||||
If strip_braces Then
|
||||
If Left(ajson, 1) = "{" And Right(ajson, 1) = "}" Then
|
||||
ajson = Mid(ajson, 2, Len(ajson) - 2)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
json_from_table = ajson
|
||||
|
||||
json_from_table = ajson
|
||||
End Function
|
||||
|
||||
Private Function EscapeJSONString(value As String) As String
|
||||
Dim i As Long
|
||||
Dim ch As String
|
||||
Dim result As String
|
||||
|
||||
result = ""
|
||||
|
||||
For i = 1 To Len(value)
|
||||
ch = Mid$(value, i, 1)
|
||||
Select Case ch
|
||||
Case """"
|
||||
result = result & "\"""
|
||||
Case "\"
|
||||
result = result & "\\"
|
||||
Case "/"
|
||||
result = result & "/"
|
||||
Case vbBack
|
||||
result = result & "\b"
|
||||
Case vbFormFeed
|
||||
result = result & "\f"
|
||||
Case vbLf
|
||||
result = result & "\n"
|
||||
Case vbCr
|
||||
result = result & "\r"
|
||||
Case vbTab
|
||||
result = result & "\t"
|
||||
Case Else
|
||||
If Asc(ch) < 32 Or Asc(ch) > 126 Then
|
||||
result = result & "\u" & Right$("000" & Hex(Asc(ch)), 4)
|
||||
Else
|
||||
result = result & ch
|
||||
End If
|
||||
End Select
|
||||
Next i
|
||||
|
||||
EscapeJSONString = result
|
||||
End Function
|
||||
|
||||
|
||||
Public Function json_from_table_zb(ByRef tbl() As Variant, ByRef array_label As String, ByVal force_array As Boolean, Optional strip_braces As Boolean) As String
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user