live check of price list against lgdat records to test if inbound charges are new or update

This commit is contained in:
Paul Trowbridge 2020-06-25 16:58:13 -04:00
parent c14ba755f8
commit d10a15f113
4 changed files with 108 additions and 13 deletions

51
FL.bas
View File

@ -1247,6 +1247,8 @@ Sub build_price_upload()
Dim pl_d2 As String Dim pl_d2 As String
Dim pl_d3 As String Dim pl_d3 As String
Dim fd As FileDialog Dim fd As FileDialog
Dim ulsql As String
Dim temp() As String
pl = x.SHTp_GetString(Selection) pl = x.SHTp_GetString(Selection)
ReDim ul(11, UBound(pl, 2)) ReDim ul(11, UBound(pl, 2))
@ -1255,14 +1257,17 @@ PRICELIST_SHOW:
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_d1 = pricelist.tbD1.Text
pl_d2 = pricelist.tbD2.Text pl_d2 = pricelist.tbD2.Text
pl_d3 = pricelist.tbD3.Text pl_d3 = pricelist.tbD3.Text
pl_action = Mid(pricelist.cbHDR.value, 1, 1) pl_action = Mid(pricelist.cbHDR.value, 1, 1)
dtl_action = Mid(pricelist.cbDTL.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") MsgBox ("price code must be 5 or less characters")
GoTo PRICELIST_SHOW GoTo PRICELIST_SHOW
End If End If
@ -1275,6 +1280,32 @@ PRICELIST_SHOW:
Call x.TBLp_FilterSingle(pl, 10, "A", True) Call x.TBLp_FilterSingle(pl, 10, "A", True)
End If 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(0, 0) = "HDR"
ul(1, 0) = pl_action ul(1, 0) = pl_action
@ -1287,15 +1318,15 @@ PRICELIST_SHOW:
j = 0 j = 0
For i = LBound(pl, 2) + 1 To UBound(pl, 2) For i = LBound(pl, 2) + 1 To UBound(pl, 2)
'if there is no [uom, part#, price], don't create a row '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 j = j + 1
ul(0, j) = "DTL" 'DTL ul(0, j) = "DTL" 'DTL
ul(1, j) = pl_code 'Price list code ul(1, j) = pl_code 'Price list code
ul(2, j) = pl(9, i) 'part number ul(2, j) = pl(8, i) 'part number
ul(3, j) = pl(7, i) 'price unit ul(3, j) = pl(6, 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(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(8, i), "0.00") 'price ul(5, j) = Format(pl(7, i), "0.00") 'price
ul(11, j) = dtl_action 'add, update, delete ul(11, j) = pl(17, i) 'add, update, delete
End If End If
Next i Next i
@ -1304,11 +1335,11 @@ PRICELIST_SHOW:
'--------Open file------------- '--------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") MsgBox ("error")
End If End If
Excel.Workbooks.Open (pricelist.tbPATH.Text & "\" & pl_code & ".csv") Excel.Workbooks.Open (pricelist.tbPATH.Text & "\" & Replace(pl_code, ".", "_") & ".csv")
'---------------------header row--------------------------------- '---------------------header row---------------------------------

BIN
login.frx

Binary file not shown.

View File

@ -1,10 +1,10 @@
VERSION 5.00 VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelist Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelist
Caption = "Price List Name" Caption = "Price List Name"
ClientHeight = 6240 ClientHeight = 7680
ClientLeft = 120 ClientLeft = 120
ClientTop = 465 ClientTop = 465
ClientWidth = 4095 ClientWidth = 8895.001
OleObjectBlob = "pricelist.frx":0000 OleObjectBlob = "pricelist.frx":0000
StartUpPosition = 1 'CenterOwner StartUpPosition = 1 'CenterOwner
End End
@ -14,6 +14,10 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Public proceed As Boolean Public proceed As Boolean
Private pl() As String
Private plv() As Variant
Private plfv() As Variant
Private Sub bCANCEL_Click() Private Sub bCANCEL_Click()
proceed = False proceed = False
@ -21,6 +25,12 @@ Private Sub bCANCEL_Click()
End Sub End Sub
Private Sub bOK_Click() Private Sub bOK_Click()
If tbPATH = "" Then
MsgBox ("no directory specified")
Exit Sub
End If
proceed = True proceed = True
Me.Hide Me.Hide
End Sub End Sub
@ -38,12 +48,40 @@ Private Sub bPICK_Click()
End Sub 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() Private Sub UserForm_Initialize()
proceed = False proceed = False
Dim x() As Variant Dim x() As Variant
Dim i As Long
ReDim x(3) ReDim x(3)
x(1) = "1 - New" x(1) = "1 - New"
x(2) = "2 - Replace" x(2) = "2 - Replace"
x(3) = "3 - Update" x(3) = "3 - Update"
@ -53,11 +91,37 @@ Private Sub UserForm_Initialize()
dtl(1) = "1 - Add" dtl(1) = "1 - Add"
dtl(2) = "2 - Update" dtl(2) = "2 - Update"
dtl(3) = "3 - Delete" dtl(3) = "3 - Delete"
cbHDR.list = x cbHDR.list = x
cbDTL.list = dtl 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 End Sub

Binary file not shown.