247 lines
7.6 KiB
QBasic
247 lines
7.6 KiB
QBasic
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
|
|
|
|
|
|
|