VBA/targets.bas

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("M1:P350").ClearContents
    Call x.SHTp_Dump(res, ws.Name, 1, 13, False, True, 15)
    
    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:K350").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("R1:AD5000").ClearContents
    Call x.SHTp_Dump(res, ws.Name, 1, 18, 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, 13, True)
    tar = x.SHTp_Get(ws.Name, 1, 18, 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
    
    '--------------------mssql merge----------------------------
    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, 18, 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
    
    '--------------------postgres merge----------------------------
    sql() = x.FILEp_GetTXT(Sheets("env").Cells(1, 2) & "\000\merge.pg.sql", 1000)
    
    sqlt = ""
    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, 18, 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.pg.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