work with target price generation

TheBigOne.cls

@@ -1497,11 +1497,11 @@ End Function
 Public Function MISCp_msgbox_cancel(ByRef Message As String, Optional ByRef TITLE As String = "") As Boolean
     
     Application.EnableCancelKey = xlDisabled
-    MsgB.tbMSG.Text = Message
+    MsgB.tbMSG.text = Message
     MsgB.Caption = TITLE
     MsgB.tbMSG.ScrollBars = fmScrollBarsBoth
     MsgB.Show
-    MISC_msgbox_cancel = MsgB.cancel
+    MISC_msgbox_cancel = MsgB.Cancel
     Application.EnableCancelKey = xlInterrupt
 
 End Function
@@ -1795,6 +1795,42 @@ errh:
 
 End Function
 
+Function FILEp_Create(ByRef path As String, ByRef text As String) As Boolean
+    
+    Dim i As Long
+    Dim j As Long
+    Dim t() As String
+    Dim wl As String
+    Dim test_empty As String
+    Dim tsf As New ADODB.Stream
+    
+    On Error GoTo errh
+    
+'    Dim f As New Scripting.FileSystemObject
+'    Dim ts As Scripting.TextStream
+'    Set ts = f.CreateTextFile(path, True, True)
+'    ts.Close
+    
+    
+    tsf.Type = 2
+    tsf.Charset = "utf-8"
+    tsf.Open
+    
+    'Set ts = f.OpenTextFile(path, ForReading, False, TristateUseDefault)
+
+    Call tsf.WriteText(text)
+    Call tsf.SaveToFile(path, adSaveCreateOverWrite)
+    
+errh:
+    If Err.Number = 0 Then
+        FILEp_Create = True
+    Else
+        MsgBox (Err.Description)
+        FILEp_Create = False
+    End If
+
+End Function
+
 Public Function ADOp_Exec(ByRef con As Integer, ByVal sql As String, Optional ApproxSixe As Long, Optional InclHeaders As Boolean, Optional ByVal value As ADOinterface, Optional ConnectTo As String, Optional IntgrtdSec As Boolean, Optional UserName As String, Optional Password As String, Optional textconfigs As String) As Boolean
     
     On Error GoTo errflag
@@ -2400,7 +2436,7 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
     Set rx = CreateObject("vbscript.regexp")
     rx.Global = True
     
-    strip_text = "[^a-zA-Z0-9 \(\)\&\'\.\-\_\,\#\""]"
+    strip_text = "[^a-zA-Z0-9 \(\)\&\'\.\-\_\,\#\""\:]"
     strip_num = "[^0-9\.]"
     strip_date = "[^0-9\/\-\:\.]"
     

targets.bas

@@ -0,0 +1,230 @@
+Attribute VB_Name = "targets"
+Option Explicit
+
+Public ws As Worksheet
+Public x As New TheBigOne
+
+Sub get_options()
+
+    Dim res() As String
+    Dim mold As String
+    Set ws = ActiveSheet
+    Dim sql As String
+    mold = ws.Cells(2, 1)
+    
+    'If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then Exit Sub
+    
+    sql = "SELECT * FROM rlarp.get_options('" & mold & "');"
+    res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidlnx01", False, "report", "", "Port=5030;Database=ubm")
+    ws.Range("L1:O35").ClearContents
+    Call x.SHTp_Dump(res, ws.Name, 1, 12, False, True, 13)
+    
+    sql = "SELECT * FROM rlarp.get_option_costs('" & mold & "');"
+    res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidlnx01", False, "report", "", "Port=5030;Database=ubm")
+    ws.Range("C1:I35").ClearContents
+    Call x.SHTp_Dump(res, ws.Name, 1, 3, False, True, 8)
+    
+    Call x.ADOp_CloseCon(0)
+    
+    
+
+End Sub
+
+Sub combine_options()
+
+    Dim mold As String
+    Dim stack() As String
+    Dim stackv() As Variant
+    Dim res() As String
+    Dim i As Long
+    Dim j As Long
+    Dim sql As String
+    Dim json As String
+    
+    Set ws = ActiveSheet
+    mold = ws.Cells(2, 1)
+    
+    stack = x.SHTp_GetString(ws.Range("L1"))
+    stack = x.TBLp_Transpose(stack)
+    stackv = x.TBLp_StringToVar(stack)
+    json = x.json_from_table(stackv, "", False)
+    sql = "SELECT * FROM rlarp.set_options($$" & vbCrLf & json & vbCrLf & "$$::jsonb)"
+    
+    res = x.ADOp_SelectS(0, sql, True, 5000, True, PostgreSQLODBC, "usmidlnx01", False, "report", "", "Port=5030;Database=ubm")
+    Call x.ADOp_CloseCon(0)
+    
+    ws.Range("Q1:AC5000").ClearContents
+    Call x.SHTp_Dump(res, ws.Name, 1, 17, False, True)
+
+End Sub
+
+Sub save_targets()
+
+    Dim path As String
+    Dim opt() As String
+    Dim tar() As String
+    Dim ws As Worksheet
+    Dim sql() As String
+    Dim sqlt As String
+    Dim targt As String
+    Dim i As Long
+    
+    'create 3 files:
+    '* options listing
+    '* list of targets as csv
+    '* list of targets embedded in sql for merge
+    
+    Set ws = ActiveSheet
+    
+    opt = x.SHTp_Get(ws.Name, 1, 12, True)
+    tar = x.SHTp_Get(ws.Name, 1, 17, True)
+    
+    path = Sheets("env").Cells(1, 2) & "\" & ActiveSheet.Cells(2, 1) & "\options.csv"
+    If Not x.FILEp_CreateCSV(path, opt) Then
+        MsgBox ("file creation error")
+        Exit Sub
+    End If
+    path = Sheets("env").Cells(1, 2) & "\" & ActiveSheet.Cells(2, 1) & "\targ.csv"
+    If Not x.FILEp_CreateCSV(path, tar) Then
+        MsgBox ("file creation error")
+        Exit Sub
+    End If
+    
+    sql() = x.FILEp_GetTXT(Sheets("env").Cells(1, 2) & "\000\merge.sql", 1000)
+    
+    For i = LBound(sql, 2) To UBound(sql, 2)
+        sqlt = sqlt & sql(0, i) & vbCrLf
+    Next i
+    
+    targt = x.SQLp_build_sql_values(x.SHTp_Get(ws.Name, 1, 17, True), True, True, PostgreSQL, False, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N")
+    
+    sqlt = Replace(sqlt, "replace_this", targt)
+    
+    If Not x.FILEp_Create(Sheets("env").Cells(1, 2) & "\" & ActiveSheet.Cells(2, 1) & "\merge.sql", sqlt) Then
+        Exit Sub
+    End If
+    
+    Dim Foldername As String
+    Foldername = Sheets("env").Cells(1, 2) & "\" & ActiveSheet.Cells(2, 1)
+    
+    Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus
+
+
+End Sub
+
+Sub get_options_old()
+
+    Dim brd() As String
+    Dim pck() As String
+    Dim acc() As String
+    Dim col() As String
+    Dim sfx() As String
+    Dim c As Object
+    Dim mold As String
+    
+    
+    Set ws = ActiveSheet
+    mold = ws.Cells(2, 1)
+
+    If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then Exit Sub
+       
+    brd = x.ADOp_SelectS(0, "select distinct substring(branding,1,1) ""Branding"", 0 ""Price"" from rlarp.itemmv where stlc = '" & mold & "'", True, 50, True)
+    pck = x.ADOp_SelectS(0, "select distinct uomp->>0 ""Packaging"", 0 ""Price"" from rlarp.itemmv where stlc = '" & mold & "'", True, 50, True)
+    acc = x.ADOp_SelectS(0, "select distinct accs_ps ""Accessories"", 0 ""Price"" from rlarp.itemmv where stlc = '" & mold & "'", True, 50, True)
+    col = x.ADOp_SelectS(0, "select distinct coltier ""Color Tier"", 0 ""Facor"" from rlarp.itemmv where stlc = '" & mold & "'", True, 50, True)
+    sfx = x.ADOp_SelectS(0, "select distinct suffix ""Suffix"" ,0 ""Factor"" from rlarp.itemmv where stlc = '" & mold & "'", True, 50, True)
+    
+    Call x.ADOp_CloseCon(0)
+    
+    ws.Range("E1:I35").ClearContents
+    
+    Call x.SHTp_Dump(brd, ws.Name, 1, 5, False, True)
+    Call x.SHTp_Dump(pck, ws.Name, 6, 5, False, True)
+    Call x.SHTp_Dump(acc, ws.Name, 13, 5, False, True)
+    Call x.SHTp_Dump(col, ws.Name, 1, 8, False, True)
+    Call x.SHTp_Dump(sfx, ws.Name, 16, 8, False, True)
+    
+    For Each c In ws.Range("F2:F30")
+        If (IsNumeric(c.value) And c.value <> "") Then c.value = CDbl(c.value)
+    Next c
+    For Each c In ws.Range("I2:I30")
+        If (IsNumeric(c.value) And c.value <> "") Then c.value = CDbl(c.value)
+    Next c
+    
+
+End Sub
+
+Sub push_options_old()
+
+    Dim brd() As String
+    Dim pkg() As String
+    Dim acc() As String
+    Dim col() As String
+    Dim sfx() As String
+    Dim mold As String
+    Dim stack() As String
+    Dim i As Long
+    Dim j As Long
+    
+    Set ws = ActiveSheet
+    mold = ws.Cells(2, 1)
+    
+    brd = x.SHTp_GetString(ws.Range("E1"))
+    pkg = x.SHTp_GetString(ws.Range("E6"))
+    acc = x.SHTp_GetString(ws.Range("E13"))
+    col = x.SHTp_GetString(ws.Range("H1"))
+    sfx = x.SHTp_GetString(ws.Range("H16"))
+    
+    j = 2
+    ReDim stack(3, UBound(brd, 2) + UBound(pkg, 2) + UBound(acc, 2) + UBound(col, 2) + UBound(sfx, 2) - 5 + 1)
+    stack(0, 0) = "entity"
+    stack(1, 0) = "attr"
+    stack(2, 0) = "val"
+    stack(3, 0) = "func"
+    stack(0, 1) = "Anchor"
+    stack(1, 1) = mold
+    stack(2, 1) = ws.Cells(2, 2)
+    stack(3, 1) = "Price"
+    For i = 2 To UBound(brd, 2)
+        stack(0, j) = "Branding"
+        stack(1, j) = brd(1, i)
+        stack(2, j) = brd(2, i)
+        stack(3, j) = brd(2, 1)
+        j = j + 1
+    Next i
+    For i = 2 To UBound(pkg, 2)
+        stack(0, j) = "Packaging"
+        stack(1, j) = pkg(1, i)
+        stack(2, j) = pkg(2, i)
+        stack(3, j) = pkg(2, 1)
+        j = j + 1
+    Next i
+    For i = 2 To UBound(acc, 2)
+        stack(0, j) = "Accessories"
+        stack(1, j) = acc(1, i)
+        stack(2, j) = acc(2, i)
+        stack(3, j) = acc(2, 1)
+        j = j + 1
+    Next i
+    For i = 2 To UBound(col, 2)
+        stack(0, j) = "Color Tier"
+        stack(1, j) = col(1, i)
+        stack(2, j) = col(2, i)
+        stack(3, j) = col(2, 1)
+        j = j + 1
+    Next i
+    For i = 2 To UBound(sfx, 2)
+        stack(0, j) = "Suffix"
+        stack(1, j) = sfx(1, i)
+        stack(2, j) = sfx(2, i)
+        stack(3, j) = sfx(2, 1)
+        j = j + 1
+    Next i
+    
+    ws.Range("L1:O100").ClearContents
+    Call x.SHTp_Dump(stack, ws.Name, 1, 12, False, True, 14)
+
+End Sub
+
+
+