diff --git a/PriceLists.bas b/PriceLists.bas index 5ccb729..e9fe895 100644 --- a/PriceLists.bas +++ b/PriceLists.bas @@ -545,6 +545,98 @@ Sub build_price_level(plev As String) effdate = CDate(pricelevel.tbEddDate.text) filepath = pricelevel.tbPATH & "\" & plev + '---------------------create new workbook------------------------------------------------------------------- + Set nwb = Application.Workbooks.Add + nwb.Activate + Set nws = nwb.Sheets(1) + segment_regex = "^G|^N|^F|^P" + + '---------------------get price list------------------------------------------------------------------------ + If pricelevel.chbNURSERY Then + pln = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "', '^N')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") + If pln(0, 0) <> "Product" Then + MsgBox (pln(0, 0)) + Exit Sub + End If + If UBound(pln, 2) > 21 Then + segment_regex = "^F|^G|^P" + Set nnws = nwb.Sheets.Add(, nws) + nnws.Name = "Price List - Nursery" + Call paste_pretty(pln, nnws, effdate, curr) + End If + End If + + If pricelevel.chbFIBER Then + plf = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','^F')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") + If plf(0, 0) <> "Product" Then + MsgBox (plf(0, 0)) + Exit Sub + End If + If UBound(plf, 2) > 21 Then + If segment_regex = "^F|^G|^P" Then + segment_regex = "^G|^P" + Else + segment_regex = "^G|^N|^P" + End If + Set nfws = nwb.Sheets.Add(, nws) + nfws.Name = "Price List - Fiber" + Call paste_pretty(plf, nfws, effdate, curr) + End If + End If + + pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','" & segment_regex & "')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") + If pl(0, 0) <> "Product" Then + MsgBox (pl(0, 0)) + Exit Sub + End If + If UBound(pl, 2) > 21 Then + nws.Name = "Price list" + Call paste_pretty(pl, nws, effdate, curr) + Else + '---if the price list has no length, then close + nwb.Close + Exit Sub + End If + + Application.ScreenUpdating = True + + '--------------------save file-------------------------------------------------------------------------------- + 'Dim fd As Object + 'Set fd = Application.FileDialog(msoFileDialogFolderPicker) + 'fd.Show + 'If fd.SelectedItems.Count = 0 Then Exit Sub + With CreateObject("Scripting.FileSystemObject") + If Not .FolderExists(filepath) Then .CreateFolder filepath + End With + Application.DisplayAlerts = True + nwb.Activate + + fname = "HC Companies Distributor Price List " & curr & ".xlsx" + + Dim wb As Workbook + For Each wb In Workbooks + If wb.Name = fname Then + If MsgBox("already have a price list open, close it?", vbOKCancel) Then + Workbooks(fname).Close + Exit For + Else + Exit Sub + End If + End If + Next wb + + If pricelevel.tbPATH.text <> "" Then nwb.SaveAs Filename:=filepath & "\" & fname + + If pricelevel.chPDF Then + fname = Replace(fname, "xlsx", "pdf") + nwb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filepath & "\" & fname, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False + End If + + If Not pricelevel.chbLEAVEOPEN Then + nwb.Close + End If + + '--------------------get full code list----------------------------- If pricelevel.chbFULLCODE Then '---------------------get full code list-------------------------------------------------------------------- fc = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_fullcode_cust('" & plev & "', '" & effdate & "'::date)", False, 20000, True, PostgreSQLODBC, "10.56.60.254", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") @@ -627,97 +719,8 @@ Sub build_price_level(plev As String) Application.PrintCommunication = True End If - 'Application.ScreenUpdating = True - 'Exit Sub - '---------------------create new workbook------------------------------------------------------------------- - Set nwb = Application.Workbooks.Add - nwb.Activate - Set nws = nwb.Sheets(1) - segment_regex = "^G|^N|^F|^P" - - '---------------------get price list------------------------------------------------------------------------ - If pricelevel.chbNURSERY Then - pln = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "', '^N')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") - If pln(0, 0) <> "Product" Then - MsgBox (pln(0, 0)) - Exit Sub - End If - If UBound(pln, 2) > 21 Then - segment_regex = "^F|^G|^P" - Set nnws = nwb.Sheets.Add(, nws) - nnws.Name = "Price List - Nursery" - Call paste_pretty(pln, nnws, effdate, curr) - End If - End If - - If pricelevel.chbFIBER Then - plf = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','^F')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") - If plf(0, 0) <> "Product" Then - MsgBox (plf(0, 0)) - Exit Sub - End If - If UBound(plf, 2) > 21 Then - If segment_regex = "^F|^G|^P" Then - segment_regex = "^G|^P" - Else - segment_regex = "^G|^N|^P" - End If - Set nfws = nwb.Sheets.Add(, nws) - nfws.Name = "Price List - Fiber" - Call paste_pretty(plf, nfws, effdate, curr) - End If - End If - - pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','" & segment_regex & "')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") - If pl(0, 0) <> "Product" Then - MsgBox (pl(0, 0)) - Exit Sub - End If - If UBound(pl, 2) > 21 Then - nws.Name = "Price list" - Call paste_pretty(pl, nws, effdate, curr) - Else - nws.Delete - End If - - Application.ScreenUpdating = True - - '--------------------save file-------------------------------------------------------------------------------- - 'Dim fd As Object - 'Set fd = Application.FileDialog(msoFileDialogFolderPicker) - 'fd.Show - 'If fd.SelectedItems.Count = 0 Then Exit Sub - With CreateObject("Scripting.FileSystemObject") - If Not .FolderExists(filepath) Then .CreateFolder filepath - End With - Application.DisplayAlerts = True - nwb.Activate - - fname = "HC Companies Distributor Price List " & curr & ".xlsx" - - Dim wb As Workbook - For Each wb In Workbooks - If wb.Name = fname Then - If MsgBox("already have a price list open, close it?", vbOKCancel) Then - Workbooks(fname).Close - Exit For - Else - Exit Sub - End If - End If - Next wb - - If pricelevel.tbPATH.text <> "" Then nwb.SaveAs Filename:=filepath & "\" & fname - - If pricelevel.chPDF Then - fname = Replace(fname, "xlsx", "pdf") - nwb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filepath & "\" & fname, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False - End If - - If Not pricelevel.chbLEAVEOPEN Then - nwb.Close - End If + '---------------------save full code list--------------------------- For Each wb In Workbooks If wb.Name = "HC FullCode List.xlsx" Then @@ -731,7 +734,7 @@ Sub build_price_level(plev As String) Next wb If Not (fcwb Is Nothing) Then - If pricelevel.tbPATH.text <> "" Then fcwb.SaveAs Filename:=filepath & "\HC FullCode List.xlsx" + If pricelevel.tbPATH.text <> "" Then fcwb.SaveAs Filename:=filepath & "\HC FullCode List " & curr & ".xlsx" If pricelevel.chPDF Then fname = Replace(fcwb.Name, "xlsx", "pdf") fcwb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filepath & "\" & fname, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False