work on target groups
This commit is contained in:
parent
e1053de60a
commit
232c0a07dd
@ -404,14 +404,14 @@ Sub BuildPricingPath()
|
|||||||
End If
|
End If
|
||||||
|
|
||||||
' === 1. Call Postgres NEW FUNCTION ===
|
' === 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"
|
"'" & Replace(optionsJSON, "'", "''") & "') WHERE lastflag"
|
||||||
|
|
||||||
res = x.ADOp_SelectS(0, sql, True, 50000, True, PostgreSQLODBC, _
|
res = x.ADOp_SelectS(0, sql, True, 50000, True, PostgreSQLODBC, _
|
||||||
"usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
|
"usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
|
||||||
|
|
||||||
ws.Range("V:ZZ").ClearContents
|
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:
|
Cleanup:
|
||||||
@ -560,3 +560,73 @@ HandleError:
|
|||||||
End Sub
|
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
|
||||||
|
|
||||||
|
112
TheBigOne.cls
112
TheBigOne.cls
@ -2363,68 +2363,120 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, tri
|
|||||||
End Function
|
End Function
|
||||||
|
|
||||||
Public Function json_from_table(ByRef tbl As Variant, ByRef array_label As String, Optional strip_braces As Boolean) As String
|
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 ajson As String
|
||||||
Dim json As String
|
Dim json As String
|
||||||
Dim r As Integer
|
Dim r As Long
|
||||||
Dim c As Integer
|
Dim c As Long
|
||||||
Dim needs_comma As Boolean
|
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_comma = False
|
||||||
needs_braces = 0
|
needs_braces = 0
|
||||||
ajson = ""
|
ajson = ""
|
||||||
|
|
||||||
For r = LBound(tbl, 1) + 1 To UBound(tbl, 1)
|
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)
|
For c = LBound(tbl, 2) To UBound(tbl, 2)
|
||||||
If tbl(r, c) <> "" Then
|
header = tbl(LBound(tbl, 1), c)
|
||||||
needs_braces = needs_braces + 1
|
value = tbl(r, c)
|
||||||
|
|
||||||
|
If header <> "" And value <> "" Then
|
||||||
If needs_comma Then json = json & ","
|
If needs_comma Then json = json & ","
|
||||||
needs_comma = True
|
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
|
Else
|
||||||
If Left(tbl(r, c), 1) = "{" Or Left(tbl(r, c), 1) = "[" Then
|
json = json & """" & EscapeJSONString(value) & """"
|
||||||
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
|
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
Next c
|
Next c
|
||||||
If needs_braces > 0 Then json = "{" & json & "}"
|
|
||||||
needs_comma = False
|
If json <> "" Then
|
||||||
needs_braces = 0
|
json = "{" & json & "}"
|
||||||
If r > LBound(tbl, 1) + 1 Then
|
If ajson = "" Then
|
||||||
ajson = ajson & "," & json
|
ajson = json
|
||||||
Else
|
Else
|
||||||
ajson = json
|
ajson = ajson & "," & json
|
||||||
|
End If
|
||||||
End If
|
End If
|
||||||
json = ""
|
|
||||||
Next r
|
Next r
|
||||||
|
|
||||||
'if theres more the one record, include brackets for array
|
' If more than one record, make an array
|
||||||
'if an array_label is given give the array a key and the array become the value
|
If InStr(ajson, "},{") > 0 Then
|
||||||
'then if the array is labeled with a key it should have braces unless specified otherwise
|
|
||||||
If r > LBound(tbl, 1) + 2 Then
|
|
||||||
ajson = "[" & ajson & "]"
|
ajson = "[" & ajson & "]"
|
||||||
If array_label <> "" Then
|
If array_label <> "" Then
|
||||||
ajson = """" & array_label & """:" & ajson
|
ajson = """" & EscapeJSONString(array_label) & """:" & ajson
|
||||||
If Not strip_braces Then
|
If Not strip_braces Then
|
||||||
ajson = "{" & ajson & "}"
|
ajson = "{" & ajson & "}"
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
Else
|
Else
|
||||||
If strip_braces Then
|
If array_label <> "" Then
|
||||||
ajson = Mid(ajson, 2, Len(ajson) - 2)
|
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
|
||||||
End If
|
End If
|
||||||
|
|
||||||
json_from_table = ajson
|
json_from_table = ajson
|
||||||
|
|
||||||
End Function
|
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
|
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