VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelist Caption = "Price List Name" ClientHeight = 7995 ClientLeft = 120 ClientTop = 465 ClientWidth = 11865 OleObjectBlob = "pricelist.frx":0000 StartUpPosition = 1 'CenterOwner End Attribute VB_Name = "pricelist" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Public proceed As Boolean Private pl() As String Private plv() As Variant Private plfv() As Variant Public tbo As New TheBigOne Private Sub bCANCEL_Click() proceed = False Me.Hide End Sub Private Sub bOK_Click() If tbPATH = "" Then MsgBox ("no directory specified") Exit Sub End If proceed = True Me.Hide End Sub Private Sub bPICK_Click() Dim fd As Object '--------Open file------------- Set fd = Application.FileDialog(msoFileDialogFolderPicker) fd.Show tbPATH.text = fd.SelectedItems(1) End Sub Private Sub cbInactive_Click() End Sub Private Sub cbLIST_Change() Dim plc() As String plc = pl Call tbo.TBLp_FilterSingle(plc, 0, cbLIST.value, True) If UBound(plc, 2) = 0 Then Exit Sub Me.tbD1 = plc(1, 1) Me.tbD2 = plc(2, 1) Me.tbD3 = plc(3, 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" Dim dtl() As Variant ReDim dtl(3) dtl(1) = "1 - Add" dtl(2) = "2 - Update" dtl(3) = "3 - Delete" cbHDR.list = x cbDTL.list = dtl login.Caption = "CMS Login" login.tbU = UCase(Mid(Mid(Application.UserLibraryPath, 10, InStr(10, Application.UserLibraryPath, "\") - 10), 1, 10)) login.tbP = "" login.Show If Not login.proceed Then Exit Sub If Not tbo.ADOp_OpenCon(1, ISeries, "S7830956", False, login.tbU.text, login.tbP.text) Then MsgBox (tbo.ADOo_errstring) Exit Sub End If pl = tbo.ADOp_SelectS(1, "SELECT JAPLCD, JAPLDS, JAPLD1, JAPLD2 FROM lgdat.iprca WHERE TRIM(COALESCE(JAPLCD,'')) <> '' ORDER BY JAPLCD ASC", True, 1000, False) 'pl = FL.x.ADOp_SelectS(1, "SELECT plcode, d1,d2,d3 FROM RLARP.PLM p ORDER BY plcode", True, 1000, True) Call tbo.ADOp_CloseCon(1) ReDim plv(1 To UBound(pl, 2)) For i = 1 To UBound(pl, 2) plv(i) = pl(0, i) Next i plfv = tbo.TBLp_StringToVar(tbo.TBLp_Transpose(pl)) cbLIST.list = plv lbLIST.list = plfv 'lbHEAD.ColumnCount = lbHist.ColumnCount 'lbHEAD.ColumnWidths = lbHist.ColumnWidths Call tbo.frmListBoxHeader(lbHEAD, lbLIST, "plcode", "descr1", "descr2", "descr3") End Sub Private Sub UserForm_Terminate() proceed = False End Sub Sub load_lists() Dim x() As Variant Dim i As Long ReDim x(3) x(1) = "1 - New" x(2) = "2 - Replace" x(3) = "3 - Update" Dim dtl() As Variant ReDim dtl(3) dtl(1) = "1 - Add" dtl(2) = "2 - Update" dtl(3) = "3 - Delete" cbHDR.list = x cbDTL.list = dtl login.Caption = "CMS Login" login.tbU = Mid(UCase(Mid(Application.UserLibraryPath, 10, InStr(10, Application.UserLibraryPath, "\") - 10)), 1, 10) login.tbP = "" login.Show If Not login.proceed Then Exit Sub If Not tbo.ADOp_OpenCon(1, ISeries, "S7830956", False, login.tbU.text, login.tbP.text) Then MsgBox (tbo.ADOo_errstring) Exit Sub End If 'pl = FL.x.ADOp_SelectS(1, "SELECT plcode, d1, d2, d3 FROM RLARP.PLM p ORDER BY plcode", True, 1000, True) pl = tbo.ADOp_SelectS(1, "SELECT JAPLCD, JAPLDS, JAPLD1, JAPLD2 FROM lgdat.iprca WHERE TRIM(COALESCE(JAPLCD,'')) <> '' ORDER BY JAPLCD ASC", True, 1000, False) Call tbo.ADOp_CloseCon(1) ReDim plv(1 To UBound(pl, 2)) For i = 1 To UBound(pl, 2) plv(i) = pl(0, i) Next i plfv = tbo.TBLp_StringToVar(tbo.TBLp_Transpose(pl)) cbLIST.list = plv lbLIST.list = plfv 'lbHEAD.ColumnCount = lbHist.ColumnCount 'lbHEAD.ColumnWidths = lbHist.ColumnWidths Call tbo.frmListBoxHeader(lbHEAD, lbLIST, "plcode", "d1", "d2", "d3") End Sub