diff --git a/TargetGroups.bas b/TargetGroups.bas index b0ee54b..bc3dd96 100644 --- a/TargetGroups.bas +++ b/TargetGroups.bas @@ -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 + diff --git a/TheBigOne.cls b/TheBigOne.cls index ea10ec1..8b7e954 100644 --- a/TheBigOne.cls +++ b/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