193 lines
6.4 KiB
QBasic
193 lines
6.4 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)
|
|
Dim onfile() As String
|
|
Dim merge() As String
|
|
Dim i As Long
|
|
Dim fpath As String
|
|
|
|
With ws.Cells.Interior
|
|
.Pattern = xlNone
|
|
.TintAndShade = 0
|
|
.PatternTintAndShade = 0
|
|
End With
|
|
|
|
'----------------get the available options from all the parts setup in the item master----------------------------------------------
|
|
sql = "SELECT * FROM rlarp.get_options('" & mold & "');"
|
|
res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
|
|
ws.Range("N1:ZZ3500").ClearContents
|
|
|
|
'----------------get the options already set if this item has been setup------------------------------------------------------------
|
|
fpath = Sheets("env").Range("B1").value & "\" & Sheets("combine").Range("A2").value & "\options.csv"
|
|
If DirectoryExists(fpath) Then
|
|
onfile = x.FILEp_GetCSV(fpath)
|
|
Call x.ARRAYp_Transpose(onfile)
|
|
'merge all the options from the item master and the saved options
|
|
merge = x.TBLp_JoinTbls(onfile, res, True, True, 2, Array(0, 1, 3), Array(0, 1, 3), Array(2))
|
|
Call x.SHTp_Dump(merge, ws.Name, ws.Cells(ws.Rows.Count, 14).End(xlUp).row, 14, False, True, 15)
|
|
'loop through each result and highlight cells that only exist on the saved file and not the item master
|
|
'the last column indicated if the option is on the item master
|
|
i = 1
|
|
Do Until ws.Cells(i, 14) = ""
|
|
If ws.Cells(i, 18) = "" Then
|
|
With ws.Cells(i, 16).Interior
|
|
.Pattern = xlSolid
|
|
.PatternColorIndex = xlAutomatic
|
|
.Color = 65535
|
|
.TintAndShade = 0
|
|
.PatternTintAndShade = 0
|
|
End With
|
|
End If
|
|
i = i + 1
|
|
Loop
|
|
'get rid of the column used to flag for color
|
|
ws.Columns(18).ClearContents
|
|
Else
|
|
Call x.SHTp_Dump(res, ws.Name, 1, 14, False, True, 15)
|
|
End If
|
|
|
|
sql = "SELECT * FROM rlarp.get_option_costs('" & mold & "') ORDER BY branding, coltier, uomp;"
|
|
res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
|
|
ws.Range("C1:L350").ClearContents
|
|
Call x.SHTp_Dump(res, ws.Name, 1, 3, False, True, 9, 10, 11)
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
End Sub
|
|
|
|
Function DirectoryExists(directory As String) As Boolean
|
|
On Error GoTo ErrorHandler
|
|
Dim tempDir As String
|
|
tempDir = Dir(directory, vbDirectory)
|
|
DirectoryExists = (tempDir <> "")
|
|
Exit Function
|
|
ErrorHandler:
|
|
'If there is any error (e.g. invalid path), return False
|
|
DirectoryExists = False
|
|
End Function
|
|
|
|
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("N1"))
|
|
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, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
ws.Range("S1:AC5000").ClearContents
|
|
Call x.SHTp_Dump(res, ws.Name, 1, 19, False, True)
|
|
|
|
End Sub
|
|
|
|
Sub save_targets()
|
|
|
|
Call targets.combine_options
|
|
|
|
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
|
|
Dim x As New TheBigOne
|
|
Dim wapi As New Windows_API
|
|
Dim tbl() As Variant
|
|
|
|
'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, 14, True)
|
|
tar = x.SHTp_Get(ws.Name, 1, 19, 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, 19, True), True, True, PostgreSQL, False, True, "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, 19, True), True, True, PostgreSQL, False, True, "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
|
|
|
|
If Not x.ADOp_Exec(0, sqlt, 1, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Else
|
|
Call x.ADOp_CloseCon(0)
|
|
End If
|
|
|
|
'Dim Foldername As String
|
|
'Foldername = Sheets("env").Cells(1, 2) & "\" & ActiveSheet.Cells(2, 1)
|
|
'Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus
|
|
|
|
ws.Cells(1, 14).CurrentRegion.Select
|
|
tbl = Selection
|
|
|
|
Call wapi.ClipBoard_SetData(x.markdown_from_table(tbl))
|
|
|
|
|
|
End Sub
|
|
|