diff --git a/FL.bas b/FL.bas index bb45c7b..e8301e5 100644 --- a/FL.bas +++ b/FL.bas @@ -561,7 +561,7 @@ Sub sql_from_range_pg_noqh() Dim wapi As New Windows_API Dim r() As String Selection.CurrentRegion.Select - Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, False)) + Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, False, "S", "S", "S", "S", "A")) End Sub @@ -793,7 +793,7 @@ Sub extract_price_matrix() If Not login.proceed Then Exit Sub - If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") Then + If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm") Then MsgBox ("not able to connect to CMS" & vbCrLf & x.ADOo_errstring) Exit Sub End If @@ -1012,7 +1012,7 @@ Sub extract_price_matrix_suff() If Not login.proceed Then Exit Sub - If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") Then + If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm") Then MsgBox ("not able to connect to CMS" & vbCrLf & x.ADOo_errstring) Exit Sub End If @@ -1341,7 +1341,7 @@ Sub price_load_pcore() ReDim Preserve pcol(pcount) ReDim typeflag(9) - If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then + If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then MsgBox (Err.Description) Exit Sub End If @@ -1535,7 +1535,7 @@ Sub nursery_parse() ' sql = tbo.ADOp_BuildInsertSQL(ext, "rlarp.nregional", True, 1, UBound(ext, 2), Array("S", "S", "N", "S")) ' sql = "truncate table rlarp.nregional;" & vbCrLf & sql & ";" -' If Not tbo.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then +' If Not tbo.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then ' MsgBox (tbo.ADOo_errstring) ' Else ' MsgBox ("Uploaded") @@ -1560,10 +1560,10 @@ Sub pricegroup_upload() Dim sql As String Selection.CurrentRegion.Select - sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "N", "S", "S", "S", "A", "A", "J") + sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "J") sql = "BEGIN;" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";" & vbCrLf & "COMMIT;" - If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then + If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "10.56.60.254", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then MsgBox (x.ADOo_errstring) Exit Sub Else @@ -1572,7 +1572,7 @@ Sub pricegroup_upload() Call x.ADOp_CloseCon(0) - sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "N", "S", "S", "S", "A", "A", "A") + sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "A") sql = "BEGIN" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";" & vbCrLf & "END" If Not x.ADOp_Exec(0, sql, 1, True, ADOinterface.SqlServer, "usmidsql01", True) Then @@ -1626,7 +1626,7 @@ Sub pricegroup_upload_db2() inc = 250 Do While i <= UBound(ul, 2) 'sql = x.ADOp_BuildInsertSQL(ul, "rlarp.price_map", True, i, WorksheetFunction.Min(i + inc, UBound(ul, 2)), Array("S", "S", "S", "S", "S", "S", "S", "N", "S", "S")) - sql = x.SQLp_build_sql_values_ranged(ul, True, True, Db2, False, True, i, i + inc, "S", "S", "S", "S", "S", "S", "S", "S", "S", "N", "S", "S", "S", "A", "A", "A") + sql = x.SQLp_build_sql_values_ranged(ul, True, True, Db2, False, True, i, i + inc, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "A") sql = "INSERT INTO rlarp.price_map " & vbCrLf & sql If Not x.ADOp_Exec(0, sql) Then MsgBox (x.ADOo_errstring) @@ -1660,4 +1660,182 @@ Sub clear_page_breaks() End Sub +Sub load_ffterr() + + Dim x As New TheBigOne + Dim sql As String + + login.Show + + If Not login.proceed Then Exit Sub + + If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, login.tbU, login.tbP, "database=ubm") Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + + sql = "BEGIN; DELETE FROM IMPORT.FFTERR; INSERT INTO import.FFTERR" + sql = sql & vbLf & x.SQLp_build_sql_values(x.SHTp_Get("FFTERR", 1, 1, True), False, True, PostgreSQL, False, True, "S", "S", "S", "S", "J") & ";" + sql = sql & vbLf & "DELETE FROM rlarp.ffterr; INSERT INTO rlarp.ffterr SELECT * FROM import.ffterr; END;" + + If Not x.ADOp_Exec(0, sql) Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + + MsgBox ("Complete") + +End Sub + +Sub load_ffcret() + + Dim x As New TheBigOne + Dim sql As String + + login.Show + + If Not login.proceed Then Exit Sub + + If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, login.tbU, login.tbP) Then + Exit Sub + End If + + sql = "BEGIN DELETE FROM RLARP.FFCRET; INSERT INTO RLARP.FFCRET" + sql = sql & vbLf & x.SQLp_build_sql_values(x.SHTp_Get("FFCRET", 1, 1, True), False, True, Db2, False, True, "S", "S", "S", "S", "N") & ";" + sql = sql & vbLf & "END" + + If Not x.ADOp_Exec(0, sql) Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + + MsgBox ("Complete") + +End Sub + +Sub load_csrca() + + Dim x As New TheBigOne + Dim sql As String + + login.Show + + If Not login.proceed Then Exit Sub + + If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, login.tbU, login.tbP, "database=ubm") Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + + sql = "BEGIN; DELETE FROM IMPORT.CSRCA; INSERT INTO import.CSRCA" + sql = sql & vbLf & x.SQLp_build_sql_values(x.SHTp_Get("CSRCA", 1, 1, True), False, True, PostgreSQL, False, True, "S", "S", "S", "S", "J") & ";" + sql = sql & vbLf & "DELETE FROM rlarp.csrca; INSERT INTO rlarp.csrca SELECT * FROM import.csrca; END;" + + If Not x.ADOp_Exec(0, sql) Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + + MsgBox ("Complete") + +End Sub + +Sub load_prm() + + Dim x As New TheBigOne + Dim sql As String + + login.Show + + If Not login.proceed Then Exit Sub + + If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, login.tbU, login.tbP, "database=ubm") Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + + sql = "BEGIN; DELETE FROM IMPORT.PRM; INSERT INTO import.prm" + sql = sql & vbLf & x.SQLp_build_sql_values(x.SHTp_Get("prm", 1, 1, True), False, True, PostgreSQL, False, True, "A", "A") & ";" + sql = sql & vbLf & "DELETE FROM rlarp.prm; INSERT INTO rlarp.prm SELECT * FROM import.prm; END;" + + If Not x.ADOp_Exec(0, sql) Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + + MsgBox ("Complete") + +End Sub + +Sub load_qrh() + + Dim x As New TheBigOne + Dim sql As String + + login.Caption = "Postgres Creds" + login.Show + If Not login.proceed Then Exit Sub + + If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, login.tbU, login.tbP, "database=ubm") Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + + login.Caption = "iSeries Creds" + login.Show + If Not login.proceed Then Exit Sub + + If Not x.ADOp_OpenCon(1, ISeries, "S7830956", False, login.tbU, login.tbP) Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + + sql = "BEGIN; DELETE FROM IMPORT.QRH; INSERT INTO import.qrh" + sql = sql & vbLf & x.SQLp_build_sql_values(x.SHTp_Get("qrh", 1, 1, True), False, True, PostgreSQL, False, True, "A", "A") & ";" + sql = sql & vbLf & "DELETE FROM rlarp.qrh; INSERT INTO rlarp.qrh SELECT * FROM import.qrh; END;" + + If Not x.ADOp_Exec(0, sql) Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + + sql = "BEGIN DELETE FROM RLARP.QRH; INSERT INTO RLARP.QRH" & vbCrLf + sql = sql & x.SQLp_build_sql_values(x.SHTp_Get("qrh", 1, 1, True), True, True, Db2, False, True, "A", "A") & ";" + sql = sql & vbCrLf & " END" + + If Not x.ADOp_Exec(1, sql) Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + +End Sub + +Sub load_index() + + Dim x As New TheBigOne + Dim sql As String + + login.Caption = "Postgres Creds" + login.Show + If Not login.proceed Then Exit Sub + + If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidsap01", False, login.tbU, login.tbP, "database=ubm") Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + + sql = "BEGIN; DELETE FROM IMPORT.COSTINDEX; INSERT INTO import.costindex" + sql = sql & vbLf & x.SQLp_build_sql_values(x.SHTp_Get("INDEX", 1, 1, True), False, True, PostgreSQL, False, True, "J", "DR", "N") & ";" + sql = sql & vbLf & "DELETE FROM rlarp.costindex; INSERT INTO rlarp.costindex SELECT * FROM import.costindex; END;" + + If Not x.ADOp_Exec(0, sql) Then + MsgBox (x.ADOo_errstring) + Exit Sub + End If + + + +End Sub + + diff --git a/PriceLists.bas b/PriceLists.bas index cf5b405..adf705b 100644 --- a/PriceLists.bas +++ b/PriceLists.bas @@ -43,7 +43,7 @@ Sub test_full20() login.Show If Not login.proceed Then Exit Sub - If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") Then + If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") Then MsgBox ("not able to connect to CMS" & vbCrLf & x.ADOo_errstring) Exit Sub End If @@ -251,7 +251,7 @@ Sub price_load_plcore() login.Show If Not login.proceed Then Exit Sub - If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU, login.tbP, "Port=5432;Database=ubm") Then + If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "10.56.60.254", False, login.tbU, login.tbP, "Port=5432;Database=ubm") Then MsgBox (x.ADOo_errstring) Exit Sub End If @@ -475,6 +475,7 @@ End Function Sub build_customer_files() Dim x As New TheBigOne + Dim i As Long Dim pl() As String Dim pln() As String Dim plf() As String @@ -497,22 +498,56 @@ Sub build_customer_files() login.Caption = "PostgreSQL Login" login.tbU = "report" login.tbP = "report" - login.Show + login.proceed = True + 'login.Show If Not login.proceed Then Exit Sub Call pricelevel.repopulate pricelevel.Show If pricelevel.cancel Then Exit Sub - plev = pricelevel.tbPriceLev.text If Not IsDate(pricelevel.tbEddDate.text) Then MsgBox ("cannot interperet date - " & pricelevel.tbEddDate.text) Exit Sub End If + + For i = 0 To pricelevel.lbPriceLev.ListCount - 1 + If pricelevel.lbPriceLev.Selected(i) Then + plev = pricelevel.lbPriceLev.list(i) + Call build_price_level(plev) + End If + Next i + + + + End Sub + + +Sub build_price_level(plev As String) + + Dim x As New TheBigOne + Dim i As Long + Dim pl() As String + Dim pln() As String + Dim plf() As String + Dim fc() As String + Dim nwb As Workbook + Dim fcwb As Workbook + Dim nws As Worksheet + Dim nnws As Worksheet + Dim nfws As Worksheet + Dim fcws As Worksheet + Dim filepath As String + Dim effdate As Date + Dim clist() As String + Dim segment_regex As String + Dim curr As String + Dim fname As String + effdate = CDate(pricelevel.tbEddDate.text) filepath = pricelevel.tbPATH & "\" & plev If pricelevel.chbFULLCODE Then '---------------------get full code list-------------------------------------------------------------------- - fc = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_fullcode_cust('" & plev & "', '" & effdate & "'::date)", False, 20000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") + fc = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_fullcode_cust('" & plev & "', '" & effdate & "'::date)", False, 20000, True, PostgreSQLODBC, "10.56.60.254", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") If fc(0, 0) <> "Currency" Then MsgBox (fc(0, 0)) Exit Sub @@ -520,7 +555,7 @@ Sub build_customer_files() '---------------------create new workbook------------------------------------------------------------------- If UBound(fc, 2) = 0 Then - MsgBox ("no full code list data for " & plev) + 'MsgBox ("no full code list data for " & plev) Exit Sub End If Application.ScreenUpdating = False @@ -588,7 +623,7 @@ Sub build_customer_files() '---------------------get price list------------------------------------------------------------------------ If pricelevel.chbNURSERY Then - pln = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "', '^N')", False, 2000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") + pln = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "', '^N')", False, 2000, True, PostgreSQLODBC, "10.56.60.254", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") If pln(0, 0) <> "Product" Then MsgBox (pln(0, 0)) Exit Sub @@ -602,7 +637,7 @@ Sub build_customer_files() End If If pricelevel.chbFIBER Then - plf = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','^F')", False, 2000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") + plf = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','^F')", False, 2000, True, PostgreSQLODBC, "10.56.60.254", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") If plf(0, 0) <> "Product" Then MsgBox (plf(0, 0)) Exit Sub @@ -619,7 +654,7 @@ Sub build_customer_files() End If End If - pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','" & segment_regex & "')", False, 2000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") + pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','" & segment_regex & "')", False, 2000, True, PostgreSQLODBC, "10.56.60.254", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") If pl(0, 0) <> "Product" Then MsgBox (pl(0, 0)) Exit Sub diff --git a/TheBigOne.cls b/TheBigOne.cls index 54fed2d..ca0b1f8 100644 --- a/TheBigOne.cls +++ b/TheBigOne.cls @@ -2193,7 +2193,7 @@ Function json_concat(list As Range) As String End Function -Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String +Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String Dim i As Long @@ -2202,7 +2202,7 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, tri Dim sql As String Dim rec As String - sql = "INSERT INTO " & target & " VALUES " & vbCrLf + sql = "INSERT INTO " & Target & " VALUES " & vbCrLf For i = start To ending rec = "" If i <> start Then sql = sql & "," & vbCrLf @@ -2621,6 +2621,17 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he rec = rec & "'" & Replace(tbl(j, i), "'", "''") & "'::jsonb" End If End If + Case "DR" '-------no regex and cast to daterange--------------------------- + rx.Pattern = strip_text + If LTrim(RTrim(tbl(j, i))) = "" And empty_as_null Then + rec = rec & "CAST(NULL AS jsonb)" + Else + If trim Then + rec = rec & "'" & Replace(LTrim(RTrim(tbl(j, i))), "'", "''") & "'::daterange" + Else + rec = rec & "'" & Replace(tbl(j, i), "'", "''") & "'::daterange" + End If + End If Case "D" '-------D = date--------------------------------------------- rx.Pattern = strip_date If LTrim(RTrim(tbl(j, i))) = "" Then @@ -2872,7 +2883,7 @@ Public Function Misc_ConvBase10(ByVal d As Double, ByVal sNewBaseDigits As Strin Dim s As String, tmp As Double, i As Integer, lastI As Integer Dim BaseSize As Integer BaseSize = Len(sNewBaseDigits) - Do While Val(d) <> 0 + Do While val(d) <> 0 tmp = d i = 0 Do While tmp >= BaseSize diff --git a/login.frx b/login.frx index decb814..aa2da2f 100644 Binary files a/login.frx and b/login.frx differ diff --git a/pricelevel.frm b/pricelevel.frm index 1ff18c6..218a5cf 100644 --- a/pricelevel.frm +++ b/pricelevel.frm @@ -1,10 +1,10 @@ VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelevel Caption = "Build Customer Price List" - ClientHeight = 7920 + ClientHeight = 9975.001 ClientLeft = 120 ClientTop = 465 - ClientWidth = 8775.001 + ClientWidth = 10620 OleObjectBlob = "pricelevel.frx":0000 StartUpPosition = 1 'CenterOwner End @@ -70,12 +70,17 @@ End Sub Sub repopulate() + Dim i As Long + Dim j As Long + Dim numRows As Long + Dim numCols As Long + Dim colWidths() As Long + Dim lbColumnWidths As String Dim pl() As String pl = x.SHTp_Get("Price Levels", 3, 1, True) + Call x.TBLp_FilterSingle(pl, 3, 0, False) Me.lbPriceLev.list = x.TBLp_StringToVar(x.TBLp_Transpose(pl)) - Dim i As Long - For i = 1 To lbPriceLev.ListCount - 1 If lbPriceLev.list(i, 0) = Selection Then lbPriceLev.Selected(i) = True @@ -84,7 +89,7 @@ Sub repopulate() End If Next i - tbEddDate.text = "06/01/2022" + tbEddDate.text = "03/01/2023" End Sub diff --git a/pricelevel.frx b/pricelevel.frx index 16726b7..5b9b4a7 100644 Binary files a/pricelevel.frx and b/pricelevel.frx differ diff --git a/pricelist.frx b/pricelist.frx index d4cb88c..401c1f3 100644 Binary files a/pricelist.frx and b/pricelist.frx differ diff --git a/targets.bas b/targets.bas index 004b21c..e68c029 100644 --- a/targets.bas +++ b/targets.bas @@ -11,22 +11,61 @@ Sub get_options() 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 - 'If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then Exit Sub + 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, "10.56.60.254", False, "report", "report", "Port=5432;Database=ubm") - ws.Range("M1:AD350").ClearContents - Call x.SHTp_Dump(res, ws.Name, 1, 13, False, True, 15) + ws.Range("N1:ZZ3500").ClearContents - sql = "SELECT * FROM rlarp.get_option_costs('" & mold & "');" + '----------------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 Len(Dir(fpath)) > 0 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, "10.56.60.254", False, "report", "report", "Port=5432;Database=ubm") - ws.Range("C1:K350").ClearContents + ws.Range("C1:L350").ClearContents Call x.SHTp_Dump(res, ws.Name, 1, 3, False, True, 8) Call x.ADOp_CloseCon(0) + + End Sub @@ -44,22 +83,24 @@ Sub combine_options() Set ws = ActiveSheet mold = ws.Cells(2, 1) - stack = x.SHTp_GetString(ws.Range("L1")) + 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, "usmidlnx01", False, "report", "", "Port=5030;Database=ubm") + res = x.ADOp_SelectS(0, sql, True, 5000, True, PostgreSQLODBC, "10.56.60.254", False, "report", "report", "Port=5432;Database=ubm") Call x.ADOp_CloseCon(0) - ws.Range("R1:AD5000").ClearContents - Call x.SHTp_Dump(res, ws.Name, 1, 18, False, True) + 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 @@ -68,6 +109,9 @@ Sub save_targets() 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 @@ -76,8 +120,8 @@ Sub save_targets() Set ws = ActiveSheet - opt = x.SHTp_Get(ws.Name, 1, 13, True) - tar = x.SHTp_Get(ws.Name, 1, 18, True) + 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 @@ -97,7 +141,7 @@ Sub save_targets() 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, True, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N") + 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) @@ -113,7 +157,7 @@ Sub save_targets() 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, True, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N") + 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) @@ -121,126 +165,21 @@ Sub save_targets() Exit Sub End If + If Not x.ADOp_Exec(0, sqlt, 1, True, PostgreSQLODBC, "usmidsap01", 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 -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 - - -