create new isolated module for working with price lists
This commit is contained in:
		
							parent
							
								
									3ce9b371ca
								
							
						
					
					
						commit
						eb630686aa
					
				
							
								
								
									
										471
									
								
								PriceLists.bas
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										471
									
								
								PriceLists.bas
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,471 @@ | |||||||
|  | Attribute VB_Name = "PriceLists" | ||||||
|  | Sub extract_price_matrix_suff() | ||||||
|  | 
 | ||||||
|  |     '------------------------------------setup------------------------------------------------- | ||||||
|  | 
 | ||||||
|  |     Dim wapi As New Windows_API | ||||||
|  |     Dim x As New TheBigOne | ||||||
|  |     Dim tbl() As Variant | ||||||
|  |     Dim unp() As String | ||||||
|  |     Dim unv() As Variant | ||||||
|  |     Dim unps() As String | ||||||
|  |     Dim sql As String | ||||||
|  |     Dim error As String | ||||||
|  |     Dim orig As Range | ||||||
|  |     Dim ini As Range | ||||||
|  |     Dim cms_pl() As String | ||||||
|  |     Dim pw As String | ||||||
|  |     Dim new_sh As Worksheet | ||||||
|  |     Dim ws As Worksheet | ||||||
|  |     Dim cp As CustomProperty | ||||||
|  |      | ||||||
|  |     '------------------------------------selection------------------------------------------------- | ||||||
|  |      | ||||||
|  |     Set ini = Application.Selection | ||||||
|  |      | ||||||
|  |     Selection.CurrentRegion.Select | ||||||
|  |      | ||||||
|  |     Set orig = Application.Selection | ||||||
|  |      | ||||||
|  |     '--------------------------------test if valid price matrix------------------------------ | ||||||
|  |      | ||||||
|  |     If Selection.Cells.Count = 1 Then | ||||||
|  |         MsgBox ("selection is not a table") | ||||||
|  |         orig.Select | ||||||
|  |         Exit Sub | ||||||
|  |     End If | ||||||
|  |      | ||||||
|  |     tbl = Selection | ||||||
|  |      | ||||||
|  |     If UBound(tbl, 1) < 2 Then error = "selection is not a valid price matrix" | ||||||
|  |     If UBound(tbl, 2) <> 9 Then error = "selection is not a valid price matrix" | ||||||
|  |      | ||||||
|  |     If Not error = "" Then | ||||||
|  |         MsgBox (error) | ||||||
|  |         Exit Sub | ||||||
|  |     End If | ||||||
|  |          | ||||||
|  |     '-----------------------------unpivot price matrix into new array----------------------------- | ||||||
|  |           | ||||||
|  |     Dim i As Long | ||||||
|  |     Dim j As Long | ||||||
|  |     Dim k As Long | ||||||
|  |     Dim m As Long | ||||||
|  |     k = 0 | ||||||
|  |     ReDim unp(9, (UBound(tbl, 1) - 1) * 3) | ||||||
|  |     'iterate through rows | ||||||
|  |     For i = 2 To UBound(tbl, 1) | ||||||
|  |         '3 iterations per row | ||||||
|  |         For m = 0 To 2 | ||||||
|  |             k = k + 1 | ||||||
|  |             'part | ||||||
|  |             unp(0, k) = tbl(i, 1)                   'stlye code | ||||||
|  |             unp(1, k) = tbl(i, 2)                   'color tier | ||||||
|  |             unp(2, k) = tbl(i, 3)                   'branding | ||||||
|  |             unp(3, k) = tbl(i, 4)                   'kit | ||||||
|  |             unp(4, k) = tbl(i, 5)                   'suffix | ||||||
|  |             unp(5, k) = tbl(i, 6)                   'container | ||||||
|  |             unp(6, k) = m + 1                       'volume break | ||||||
|  |             unp(7, k) = tbl(i, 7 + m)               'price | ||||||
|  |             unp(8, k) = i                           'orig row | ||||||
|  |             unp(9, k) = 7 + m                       'orig col | ||||||
|  |         Next m | ||||||
|  |     Next i | ||||||
|  |     unp(0, 0) = "stlc" | ||||||
|  |     unp(1, 0) = "coltier" | ||||||
|  |     unp(2, 0) = "branding" | ||||||
|  |     unp(3, 0) = "accs" | ||||||
|  |     unp(4, 0) = "suffix" | ||||||
|  |     unp(5, 0) = "container" | ||||||
|  |     unp(6, 0) = "volume" | ||||||
|  |     unp(7, 0) = "price" | ||||||
|  |     unp(8, 0) = "orig_row" | ||||||
|  |     unp(9, 0) = "orig_col" | ||||||
|  |      | ||||||
|  |      | ||||||
|  |     If Not x.TBLp_TestNumeric(unp, 7) Then | ||||||
|  |         MsgBox ("price is text") | ||||||
|  |         Exit Sub | ||||||
|  |     End If | ||||||
|  |      | ||||||
|  |     unp = x.TBLp_Transpose(unp) | ||||||
|  |     unv = x.TBLp_StringToVar(unp) | ||||||
|  |      | ||||||
|  |     '-------------------------prepare sql to upload--------------------------------------------------------------- | ||||||
|  |      | ||||||
|  |     'sql = x.SQLp_build_sql_values(unp, False, True, Db2, False) | ||||||
|  |     sql = x.json_from_table(unv, "", False) | ||||||
|  |     sql = "SELECT * FROM rlarp.build_f20_suff($$" & sql & "$$::jsonb)" | ||||||
|  |     Call wapi.ClipBoard_SetData(sql) | ||||||
|  |      | ||||||
|  |     'If MsgBox(sql, vbOKCancel, "continue with build?") = vbCancel Then Exit Sub | ||||||
|  |     'Exit Sub | ||||||
|  |     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=5030;Database=ubm") Then | ||||||
|  |         MsgBox ("not able to connect to CMS" & vbCrLf & x.ADOo_errstring) | ||||||
|  |         Exit Sub | ||||||
|  |     End If | ||||||
|  |      | ||||||
|  |     cms_pl = x.ADOp_SelectS(0, sql, True, 50000, True) | ||||||
|  |      | ||||||
|  |     Call x.ADOp_CloseCon(0) | ||||||
|  |      | ||||||
|  |     'Exit Sub | ||||||
|  |      | ||||||
|  |     '--------------------------setup an output sheet if necessary------------------------------- | ||||||
|  |      | ||||||
|  |     For Each ws In Application.Worksheets | ||||||
|  |         For Each cp In ws.CustomProperties | ||||||
|  |             If cp.Name = "spec_name" And cp.value = "price_list" Then | ||||||
|  |                 Set new_sh = ws | ||||||
|  |                 Exit For | ||||||
|  |             End If | ||||||
|  |         Next cp | ||||||
|  |     Next ws | ||||||
|  |      | ||||||
|  |     If new_sh Is Nothing Then | ||||||
|  |         Set new_sh = Application.Worksheets.Add | ||||||
|  |         Call new_sh.CustomProperties.Add("spec_name", "price_list") | ||||||
|  |         new_sh.Name = "Price Build" | ||||||
|  |     End If | ||||||
|  |      | ||||||
|  |     '-------------------------dump contents------------------------------------------------------ | ||||||
|  |      | ||||||
|  |     Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True) | ||||||
|  |     new_sh.Select | ||||||
|  |     ActiveSheet.Cells(1, 1).CurrentRegion.Select | ||||||
|  |     Selection.Columns.AutoFit | ||||||
|  |      | ||||||
|  |     Rows("1:1").Select | ||||||
|  |     With ActiveWindow | ||||||
|  |         .SplitColumn = 0 | ||||||
|  |         .SplitRow = 1 | ||||||
|  |     End With | ||||||
|  |     ActiveWindow.FreezePanes = True | ||||||
|  |      | ||||||
|  |      | ||||||
|  |     '--------------------------format source cells for any build issues-------------------------------- | ||||||
|  |      | ||||||
|  |     orig.Worksheet.Select | ||||||
|  |      | ||||||
|  |     With orig.Interior | ||||||
|  |         .Pattern = xlNone | ||||||
|  |         .TintAndShade = 0 | ||||||
|  |         .PatternTintAndShade = 0 | ||||||
|  |     End With | ||||||
|  |      | ||||||
|  |     'if a cell has even one valid hit, don't show an error | ||||||
|  |     'create a copy of tbl | ||||||
|  |     'the default value for cell is error, if any good values are found, they stay | ||||||
|  |      | ||||||
|  |     j = 0 | ||||||
|  |     For i = 1 To UBound(cms_pl, 1) | ||||||
|  |         Select Case cms_pl(i, 15) | ||||||
|  |             Case "" | ||||||
|  |                 orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor = xlThemeColorAccent6 | ||||||
|  |             Case "No UOM Conversion" | ||||||
|  |                 If orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then | ||||||
|  |                     orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(255, 255, 161) | ||||||
|  |                 End If | ||||||
|  |             Case "Inactive" | ||||||
|  |                 If orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then | ||||||
|  |                     orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(255, 20, 161) | ||||||
|  |                 End If | ||||||
|  |             Case "No SKU" | ||||||
|  |                 If orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then | ||||||
|  |                     orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(20, 255, 161) | ||||||
|  |                 End If | ||||||
|  |         End Select | ||||||
|  |         'if the current row/column is OK, advance to the next row/column | ||||||
|  |         j = 0 | ||||||
|  |         Do Until cms_pl(i, 13) <> cms_pl(i + j, 13) Or cms_pl(i, 14) <> cms_pl(i + j, 14) | ||||||
|  |             j = j + 1 | ||||||
|  |             If i + j >= UBound(cms_pl, 1) Then Exit Do | ||||||
|  |         Loop | ||||||
|  |         i = i + j - 1 '-1 becuase the "next i" will increment by 1 again | ||||||
|  |     Next i | ||||||
|  |      | ||||||
|  |     Dim cell As Range | ||||||
|  |      | ||||||
|  |     For Each cell In Application.Selection.Cells | ||||||
|  |         'if the cell fill is green, then a known good part was found, so cell to blank | ||||||
|  |         If cell.Interior.ThemeColor = xlThemeColorAccent6 Then | ||||||
|  |             cell.Interior.Pattern = xlNone | ||||||
|  |         Else | ||||||
|  |             If cell.Interior.Pattern = xlNone And cell.value <> "" Then | ||||||
|  |                 cell.Interior.Color = RGB(255, 255, 161) | ||||||
|  |             End If | ||||||
|  |         End If | ||||||
|  |         'if at this point the cell has no background, then there is no part, so highlight it, but only if a price is listed | ||||||
|  |     Next cell | ||||||
|  |      | ||||||
|  |     Selection.Columns(1).Interior.Pattern = xlNone | ||||||
|  |     Selection.Columns(2).Interior.Pattern = xlNone | ||||||
|  |     Selection.Columns(3).Interior.Pattern = xlNone | ||||||
|  |     Selection.Columns(4).Interior.Pattern = xlNone | ||||||
|  |     Selection.Columns(5).Interior.Pattern = xlNone | ||||||
|  |     Selection.Columns(6).Interior.Pattern = xlNone | ||||||
|  |     Selection.Rows(1).Interior.Pattern = xlNone | ||||||
|  | 
 | ||||||
|  |      | ||||||
|  |     '----------------------------cleanup------------------------------------------------------------- | ||||||
|  |      | ||||||
|  |     Set x = Nothing | ||||||
|  |      | ||||||
|  |     ini.Select | ||||||
|  |      | ||||||
|  |      | ||||||
|  | End Sub | ||||||
|  | 
 | ||||||
|  | Sub price_load_plcore() | ||||||
|  | 
 | ||||||
|  |     Dim x As New TheBigOne      'function library | ||||||
|  |     Dim sh As Worksheet         'target worksheet | ||||||
|  |     Dim big() As String         'all price lists in one array | ||||||
|  |     Dim unpivot() As String     'unwrap the columns into volume level rows | ||||||
|  |     Dim load() As String        'individual price list to be loaded | ||||||
|  |     Dim pcount As Long          'count of price list | ||||||
|  |     Dim pcol() As Long          'hold the positions of each price list | ||||||
|  |     ReDim pcol(30)              'size the array starting with 30 and trim later | ||||||
|  |     Dim dcol() As Integer       'columns to be deleted | ||||||
|  |     Dim typeflag() As String    'array of column types | ||||||
|  |     Dim i As Long               'walks through each price list | ||||||
|  |     Dim j As Long               'walks through each original row | ||||||
|  |     Dim k As Long               'creates new rows for each price break | ||||||
|  |     Dim m As Long               'row position in the new table | ||||||
|  |     Dim sql As String | ||||||
|  |      | ||||||
|  |     '-------identify the active sheet and load the contents to an array----------- | ||||||
|  |      | ||||||
|  |     Set sh = ActiveSheet | ||||||
|  |     big = x.SHTp_Get(sh.Name, 3, 1, True) | ||||||
|  |      | ||||||
|  |     '------iterate through the column headers to identify the price lists--------- | ||||||
|  |      | ||||||
|  |     pcount = 0 | ||||||
|  |     For i = 0 To UBound(big, 1) | ||||||
|  |         If big(i, 0) = "plist" Then | ||||||
|  |             pcount = pcount + 1 | ||||||
|  |             pcol(pcount) = i | ||||||
|  |         End If | ||||||
|  |     Next i | ||||||
|  |      | ||||||
|  |     '------if no columns are labeled plist then exit------------------------------ | ||||||
|  |      | ||||||
|  |     If pcount = 0 Then Exit Sub | ||||||
|  |     ReDim Preserve pcol(pcount) | ||||||
|  |     ReDim typeflag(9) | ||||||
|  |      | ||||||
|  |     If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then | ||||||
|  |         MsgBox (Err.Description) | ||||||
|  |         Exit Sub | ||||||
|  |     End If | ||||||
|  |      | ||||||
|  |     '------prepare upload for each price list------------------------------------- | ||||||
|  |      | ||||||
|  |     typeflag(0) = "S" | ||||||
|  |     typeflag(1) = "S" | ||||||
|  |     typeflag(2) = "S" | ||||||
|  |     typeflag(3) = "S" | ||||||
|  |     typeflag(4) = "S" | ||||||
|  |     typeflag(5) = "S" | ||||||
|  |     typeflag(6) = "S" | ||||||
|  |     typeflag(7) = "N" | ||||||
|  |     typeflag(8) = "N" | ||||||
|  |     typeflag(9) = "S" | ||||||
|  |      | ||||||
|  |     For pcount = 1 To UBound(pcol) | ||||||
|  |         '----since there are 3 price columns, those will need transformed to 3 price rows per each original----- | ||||||
|  |         ReDim load(9, UBound(big, 2) * 3) | ||||||
|  |         '----set headers----- | ||||||
|  |         load(0, 0) = "stlc" | ||||||
|  |         load(1, 0) = "coltier" | ||||||
|  |         load(2, 0) = "branding" | ||||||
|  |         load(3, 0) = "accs" | ||||||
|  |         load(4, 0) = "suff" | ||||||
|  |         load(5, 0) = "uomp" | ||||||
|  |         load(6, 0) = "vol_uom" | ||||||
|  |         load(7, 0) = "vol_qty" | ||||||
|  |         load(8, 0) = "vol_price" | ||||||
|  |         load(9, 0) = "listcode" | ||||||
|  |         '-----populate------------ | ||||||
|  |         m = 1 | ||||||
|  |         For i = 1 To UBound(big, 2) | ||||||
|  |             '-----hard coded to number of price breaks (3)------- | ||||||
|  |             For k = 0 To 2 | ||||||
|  |                 load(0, m) = big(0, i) | ||||||
|  |                 load(1, m) = big(1, i) | ||||||
|  |                 load(2, m) = big(2, i) | ||||||
|  |                 load(3, m) = big(3, i) | ||||||
|  |                 load(4, m) = big(4, i) | ||||||
|  |                 '----position 3 is a bulk pallet so the default UOM needs hard coded to PLT----- | ||||||
|  |                 If k = 2 Then | ||||||
|  |                     load(5, m) = "PLT" | ||||||
|  |                 Else | ||||||
|  |                     load(5, m) = big(5, i) | ||||||
|  |                 End If | ||||||
|  |                 '----(3-k) should work out to 1st 2nd 3rd price colum---------------------------- | ||||||
|  |                 '----the first column UOM is the default package, everything else is a pallet---- | ||||||
|  |                 If k = 0 Then | ||||||
|  |                     load(6, m) = big(5, i) | ||||||
|  |                 Else | ||||||
|  |                     load(6, m) = "PLT" | ||||||
|  |                 End If | ||||||
|  |                 '----for now the volumes are always 1 of the unit of measure in colunm 6 above | ||||||
|  |                 load(7, m) = "1" | ||||||
|  |                 load(8, m) = Format(big(pcol(pcount) - (3 - k), i), "####0.00") | ||||||
|  |                 load(9, m) = big(pcol(pcount) - 0, i) | ||||||
|  |                 m = m + 1 | ||||||
|  |             Next k | ||||||
|  |         Next i | ||||||
|  |         '------build insert statement for target price list----- | ||||||
|  |         sql = "BEGIN;" | ||||||
|  |         sql = sql & vbCrLf & "DELETE FROM rlarp.plcore WHERE listcode = '" & load(9, 1) & "';" | ||||||
|  |         sql = sql & vbCrLf & "INSERT INTO rlarp.plcore" | ||||||
|  |         sql = sql & vbCrLf & x.SQLp_build_sql_values(load, True, True, PostgreSQL, False, "S", "S", "S", "S", "S", "S", "S", "N", "N", "S") & ";" | ||||||
|  |         sql = sql & vbCrLf & "COMMIT;" | ||||||
|  |         '------do the insert------------------------------------ | ||||||
|  |         If Not x.ADOp_Exec(0, sql) Then | ||||||
|  |             MsgBox (x.ADOo_errstring) | ||||||
|  |             Exit Sub | ||||||
|  |         End If | ||||||
|  |     Next pcount | ||||||
|  |      | ||||||
|  |     Call x.ADOp_CloseCon(0) | ||||||
|  |      | ||||||
|  |      | ||||||
|  | End Sub | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | Sub build_price_upload_suff() | ||||||
|  | 
 | ||||||
|  |     Dim x As New TheBigOne | ||||||
|  |     Dim pl() As String | ||||||
|  |     Dim plv() As Variant | ||||||
|  |     Dim i As Long | ||||||
|  |     Dim j As Long | ||||||
|  |     Dim ul() As String | ||||||
|  |     Dim pl_code As String | ||||||
|  |     Dim pl_action As String | ||||||
|  |     Dim dtl_action As String | ||||||
|  |     Dim pl_d1 As String | ||||||
|  |     Dim pl_d2 As String | ||||||
|  |     Dim pl_d3 As String | ||||||
|  |     Dim fd As FileDialog | ||||||
|  |     Dim ulsql As String | ||||||
|  |     Dim temp() As String | ||||||
|  |     Dim wapi As New Windows_API | ||||||
|  |      | ||||||
|  |      | ||||||
|  |     pl = x.SHTp_GetString(Selection) | ||||||
|  |     ReDim ul(11, UBound(pl, 2)) | ||||||
|  |      | ||||||
|  | PRICELIST_SHOW: | ||||||
|  |      | ||||||
|  |     Call pricelist.load_lists | ||||||
|  |      | ||||||
|  |     pricelist.Show | ||||||
|  |      | ||||||
|  |     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.cbLIST.value) > 5 Then | ||||||
|  |         MsgBox ("price code must be 5 or less characters") | ||||||
|  |         GoTo PRICELIST_SHOW | ||||||
|  |     End If | ||||||
|  |      | ||||||
|  |     '--------------remove any lines with errors------------- | ||||||
|  |     If Not pricelist.cbInactive Then | ||||||
|  |         Call x.TBLp_FilterSingle(pl, 16, "", True) | ||||||
|  |     End If | ||||||
|  |      | ||||||
|  |     '--------------remove empty price lines----------------- | ||||||
|  |     Call x.TBLp_FilterSingle(pl, 13, "", False) | ||||||
|  |      | ||||||
|  |     If Not pricelist.cbNonStocked Then | ||||||
|  |         Call x.TBLp_FilterSingle(pl, 8, "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, PostgreSQL, False) | ||||||
|  |     'pl = x.TBLp_Transpose(pl) | ||||||
|  |     'plv = x.TBLp_StringToVar(pl) | ||||||
|  |     'ulsql = x.json_from_table(plv, "") | ||||||
|  |     '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 | ||||||
|  |     'Call wapi.ClipBoard_SetData(ulsql) | ||||||
|  |     'Exit Sub | ||||||
|  | 
 | ||||||
|  |     'If Not FL.x.ADOp_Exec(0, ulsql, 1, True, ISeries, "S7830956", False, "PTROWBRIDG", "QQQX53@041") 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 | ||||||
|  |     ul(2, 0) = pl_code | ||||||
|  |     ul(3, 0) = Left(pl_d1, 30) | ||||||
|  |     ul(4, 0) = Left(pl_d2, 30) | ||||||
|  |     ul(5, 0) = Left(pl_d3, 30) | ||||||
|  |     ul(6, 0) = "Y" | ||||||
|  |     ul(7, 0) = "N" | ||||||
|  |     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(11, i) <> "" And pl(7, i) <> "" And pl(6, i) <> "" And pl(13, i) <> "" Then | ||||||
|  |             j = j + 1 | ||||||
|  |             ul(0, j) = "DTL"                                                                'DTL | ||||||
|  |             ul(1, j) = pl_code                                                              'Price list code | ||||||
|  |             ul(2, j) = pl(6, i)                                                             'part number | ||||||
|  |             ul(3, j) = pl(12, i)                                                            'price unit | ||||||
|  |             ul(4, j) = Format(pl(11, i), "0.00000")                                            'volume break in price uom | ||||||
|  |             ul(5, j) = Format(pl(13, i), "0.00000")                                            'price | ||||||
|  |             ul(11, j) = dtl_action                                                          'add, update, delete | ||||||
|  |         End If | ||||||
|  |     Next i | ||||||
|  |      | ||||||
|  |     ReDim Preserve ul(11, j) | ||||||
|  | 
 | ||||||
|  |      | ||||||
|  |     '--------Open file------------- | ||||||
|  |      | ||||||
|  |     If Not x.FILEp_CreateCSV(pricelist.tbPATH.text & "\" & Replace(pl_code, ".", "_") & ".csv", ul) Then | ||||||
|  |         MsgBox ("error") | ||||||
|  |     End If | ||||||
|  |      | ||||||
|  |     'Excel.Workbooks.Open (pricelist.tbPATH.Text & "\" & Replace(pl_code, ".", "_") & ".csv") | ||||||
|  |      | ||||||
|  |     '---------------------header row--------------------------------- | ||||||
|  |      | ||||||
|  | 
 | ||||||
|  | End Sub | ||||||
		Loading…
	
		Reference in New Issue
	
	Block a user