diff --git a/FL.bas b/FL.bas index 726b752..efe152e 100644 --- a/FL.bas +++ b/FL.bas @@ -1247,6 +1247,8 @@ Sub build_price_upload() Dim pl_d2 As String Dim pl_d3 As String Dim fd As FileDialog + Dim ulsql As String + Dim temp() As String pl = x.SHTp_GetString(Selection) ReDim ul(11, UBound(pl, 2)) @@ -1255,14 +1257,17 @@ PRICELIST_SHOW: pricelist.Show - pl_code = pricelist.tbCODE.Text + If Not pricelist.proceed Then Exit Sub + + pl_code = pricelist.cbLIST.value pl_d1 = pricelist.tbD1.Text pl_d2 = pricelist.tbD2.Text pl_d3 = pricelist.tbD3.Text pl_action = Mid(pricelist.cbHDR.value, 1, 1) dtl_action = Mid(pricelist.cbDTL.value, 1, 1) - If Len(pricelist.tbCODE) > 5 Then + + If Len(pricelist.cbLIST.value) > 5 Then MsgBox ("price code must be 5 or less characters") GoTo PRICELIST_SHOW End If @@ -1275,6 +1280,32 @@ PRICELIST_SHOW: Call x.TBLp_FilterSingle(pl, 10, "A", True) End If + 'need to get the current list of products and if they already exist for the target price list + 'target price list + 'target part + 'target volume level + + + ulsql = FL.x.SQLp_build_sql_values(pl, True, True, Db2, False) + ulsql = "DECLARE GLOBAL TEMPORARY TABLE session.plb AS (" & ulsql & ") WITH DATA" + If login.tbP.Text = "" Then + login.Show + If Not login.proceed Then + Exit Sub + End If + End If + If Not FL.x.ADOp_Exec(0, ulsql, 1, True, ISeries, "S7830956", False, login.tbU.Text, login.tbP.Text) Then + MsgBox (FL.x.ADOo_errstring) + Exit Sub + End If + + pl = FL.x.ADOp_SelectS(0, "SELECT p.*, CASE WHEN COALESCE(c.jcpart,'') = '' THEN '1' ELSE '2' END flag FROM Session.plb P LEFT OUTER JOIN lgdat.iprcc c ON c.jcpart = P.Item AND c.JCPLCD = '" & pl_code & "' AND c.JCVOLL = p.vbqty * cast(p.num as float) / cast(p.den as float)", True, 10000, True) + If Not FL.x.ADOp_Exec(0, "DROP TABLE SESSION.PLB", 1, True, ISeries, "S7830956", False, login.tbU.Text, login.tbP.Text) Then + MsgBox (FL.x.ADOo_errstring) + Exit Sub + End If + Call FL.x.ADOp_CloseCon(0) + ul(0, 0) = "HDR" ul(1, 0) = pl_action @@ -1287,15 +1318,15 @@ PRICELIST_SHOW: j = 0 For i = LBound(pl, 2) + 1 To UBound(pl, 2) 'if there is no [uom, part#, price], don't create a row - If pl(12, i) <> "" And pl(13, i) <> "" And pl(8, i) <> "" And pl(9, i) <> "" Then + If pl(11, i) <> "" And pl(12, i) <> "" And pl(7, i) <> "" And pl(8, i) <> "" Then j = j + 1 ul(0, j) = "DTL" 'DTL ul(1, j) = pl_code 'Price list code - ul(2, j) = pl(9, i) 'part number - ul(3, j) = pl(7, i) 'price unit - ul(4, j) = Format(CDbl(pl(6, i)) * CDbl(pl(12, i)) / CDbl(pl(13, i)), "0.00") 'volume break in price uom - ul(5, j) = Format(pl(8, i), "0.00") 'price - ul(11, j) = dtl_action 'add, update, delete + ul(2, j) = pl(8, i) 'part number + ul(3, j) = pl(6, i) 'price unit + ul(4, j) = Format(CDbl(pl(5, i)) * CDbl(pl(11, i)) / CDbl(pl(12, i)), "0.00") 'volume break in price uom + ul(5, j) = Format(pl(7, i), "0.00") 'price + ul(11, j) = pl(17, i) 'add, update, delete End If Next i @@ -1304,11 +1335,11 @@ PRICELIST_SHOW: '--------Open file------------- - If Not x.FILEp_CreateCSV(pricelist.tbPATH.Text & "\" & pl_code & ".csv", ul) Then + If Not x.FILEp_CreateCSV(pricelist.tbPATH.Text & "\" & Replace(pl_code, ".", "_") & ".csv", ul) Then MsgBox ("error") End If - Excel.Workbooks.Open (pricelist.tbPATH.Text & "\" & pl_code & ".csv") + Excel.Workbooks.Open (pricelist.tbPATH.Text & "\" & Replace(pl_code, ".", "_") & ".csv") '---------------------header row--------------------------------- diff --git a/login.frx b/login.frx index ee5b39b..d01e723 100644 Binary files a/login.frx and b/login.frx differ diff --git a/pricelist.frm b/pricelist.frm index 21f0662..c35f072 100644 --- a/pricelist.frm +++ b/pricelist.frm @@ -1,10 +1,10 @@ VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelist Caption = "Price List Name" - ClientHeight = 6240 + ClientHeight = 7680 ClientLeft = 120 ClientTop = 465 - ClientWidth = 4095 + ClientWidth = 8895.001 OleObjectBlob = "pricelist.frx":0000 StartUpPosition = 1 'CenterOwner End @@ -14,6 +14,10 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Public proceed As Boolean +Private pl() As String +Private plv() As Variant +Private plfv() As Variant + Private Sub bCANCEL_Click() proceed = False @@ -21,6 +25,12 @@ Private Sub bCANCEL_Click() End Sub Private Sub bOK_Click() + + If tbPATH = "" Then + MsgBox ("no directory specified") + Exit Sub + End If + proceed = True Me.Hide End Sub @@ -38,12 +48,40 @@ Private Sub bPICK_Click() End Sub +Private Sub cbLIST_Change() + + Dim plc() As String + plc = pl + Call FL.x.TBLp_FilterSingle(plc, 0, cbLIST.value, True) + If UBound(plc, 2) = 0 Then Exit Sub + Me.tbD1 = plc(5, 1) + 'Me.tbD2 = plc(12, 1) + 'Me.tbD3 = plc(13, 1) + +End Sub + +Private Sub lbLIST_Click() + + Dim i As Long + + For i = 1 To lbLIST.ListCount + If lbLIST.Selected(i) Then + cbLIST.value = lbLIST.list(i, 0) + Exit Sub + End If + Next i + + Me.cbHDR.value = "3 - Update" + +End Sub Private Sub UserForm_Initialize() proceed = False Dim x() As Variant + Dim i As Long ReDim x(3) + x(1) = "1 - New" x(2) = "2 - Replace" x(3) = "3 - Update" @@ -53,11 +91,37 @@ Private Sub UserForm_Initialize() dtl(1) = "1 - Add" dtl(2) = "2 - Update" dtl(3) = "3 - Delete" - + cbHDR.list = x cbDTL.list = dtl + If login.tbP = "" Then + login.Show + If Not login.proceed Then Exit Sub + If Not FL.x.ADOp_OpenCon(0, ISeries, "S7830956", False, login.tbU, login.tbP) Then + MsgBox (FL.x.ADOo_errstring) + Exit Sub + End If + End If + + pl = FL.x.ADOp_SelectS(0, "SELECT plcode, func, basis, tier, currency, d1 FROM RLARP.PLM p ORDER BY func, tier", True, 1000, True) + Call FL.x.ADOp_CloseCon(0) + ReDim plv(1 To UBound(pl, 2)) + For i = 1 To UBound(pl, 2) + plv(i) = pl(0, i) + Next i + + plfv = FL.x.TBLp_StringToVar(FL.x.TBLp_Transpose(pl)) + + cbLIST.list = plv + lbLIST.list = plfv + + 'lbHEAD.ColumnCount = lbHist.ColumnCount + 'lbHEAD.ColumnWidths = lbHist.ColumnWidths + + Call FL.x.frmListBoxHeader(lbHEAD, lbLIST, "plcode", "func", "basis", "tier", "currency", "d1") + End Sub diff --git a/pricelist.frx b/pricelist.frx index a36285e..2601fe8 100644 Binary files a/pricelist.frx and b/pricelist.frx differ