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

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(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
     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---------------------------------
     

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