diff --git a/TargetGroups.bas b/TargetGroups.bas index ad04854..4e77366 100644 --- a/TargetGroups.bas +++ b/TargetGroups.bas @@ -29,6 +29,7 @@ Sub ReadConfig() Dim configPath As String Dim reviewGroup As String Dim regexPattern As String + Dim majg As String Dim volumeCode As String Dim statusCode As String Dim fso As Object @@ -71,18 +72,21 @@ Sub ReadConfig() regexPattern = ReadINI("Filter", "ProductFamilyRegex", configPath) volumeCode = ReadINI("Filter", "VolumeUOM", configPath) statusCode = ReadINI("Filter", "StatusCode", configPath) + majg = ReadINI("Filter", "MajorGroups", configPath) ' === 5. Handle empty values with fallback === If reviewGroup = "" Then reviewGroup = "(not defined)" If regexPattern = "" Then regexPattern = "(not defined)" If volumeCode = "" Then volumeCode = "GAL" If statusCode = "" Then statusCode = "FALSE" + If majg = "" Then majg = ".*" ' === 6. Write results to Excel cells === Sheets("combine").Range("A2").value = reviewGroup Sheets("combine").Range("A5").value = regexPattern Sheets("combine").Range("A8").value = volumeCode Sheets("combine").Range("A11").value = statusCode + Sheets("combine").Range("A14").value = majg ' === 7. Load options === Call LoadOptionsAndCosts @@ -106,6 +110,7 @@ Sub WriteConfig() ' Values to write Dim reviewGroup As String Dim regexPattern As String + Dim majg As String On Error GoTo HandleError @@ -135,6 +140,8 @@ Sub WriteConfig() If regexPattern = "" Then regexPattern = ".*" ' default fallback volumeCode = trim(Sheets("combine").Cells(8, 1).value) statusCode = trim(Sheets("combine").Cells(11, 1).value) + majg = trim(Sheets("combine").Cells(14, 1).value) + If majg = "" Then majg = ".*" ' default fallback ' === 4. Ensure target folder exists === If Not fso.FolderExists(targetFolder) Then @@ -148,6 +155,7 @@ Sub WriteConfig() ts.WriteLine "ProductFamilyRegex = " & regexPattern ts.WriteLine "VolumeUOM = " & volumeCode ts.WriteLine "StatusCode = " & statusCode + ts.WriteLine "MajorGroups = " & majg ts.Close ' === 6. Done silently === @@ -221,6 +229,7 @@ Sub LoadOptionsAndCosts() Dim csvTable As Variant Dim optionsJSON As String Dim pricegroup As String + Dim majg As String Dim folder As String Dim sql As String Dim fpath As String @@ -235,6 +244,7 @@ Sub LoadOptionsAndCosts() ' === Read mold (regex) and folder === pricegroup = trim(ws.Cells(ROW_REGEX, COL_REGEX).value) + majg = ws.Range("A14").value folder = trim(ws.Cells(ROW_FOLDER, COL_FOLDER).value) If pricegroup = "" Then @@ -264,7 +274,9 @@ Sub LoadOptionsAndCosts() End If ' === 2. Get option costs === - sql = "SELECT * FROM rlarp.get_option_costs_priceg('" & Replace(pricegroup, "'", "''") & "') " & _ + sql = "SELECT * FROM rlarp.get_option_costs_priceg(" & _ + "'" & Replace(pricegroup, "'", "''") & "', " & _ + "'" & Replace(majg, "'", "''") & "') " & _ "ORDER BY branding, coltier, uomp;" res = x.ADOp_SelectS(0, sql, True, 10000, True, PostgreSQLODBC, _ "usmidsap02", False, "report", "report", "Port=5432;Database=ubm") @@ -445,6 +457,7 @@ Sub BuildOptionsAndCosts() Dim i As Long Dim x As New TheBigOne Dim fso As Object + Dim majg As String On Error GoTo HandleError @@ -454,6 +467,7 @@ Sub BuildOptionsAndCosts() ' === Read mold (regex) and folder === pricegroup = trim(ws.Cells(ROW_REGEX, COL_REGEX).value) folder = trim(ws.Cells(ROW_FOLDER, COL_FOLDER).value) + majg = ws.Range("A14").value If pricegroup = "" Then MsgBox "Error: No regex pattern provided in cell A5.", vbExclamation @@ -478,6 +492,7 @@ Sub BuildOptionsAndCosts() ' === 1. Call Postgres for merged options === sql = "SELECT * FROM rlarp.get_options_merged(" & _ "'" & Replace(pricegroup, "'", "''") & "', " & _ + "'" & Replace(majg, "'", "''") & "', " & _ "'" & Replace(optionsJSON, "'", "''") & "');" res = x.ADOp_SelectS(0, sql, True, 10000, True, PostgreSQLODBC, _ @@ -486,7 +501,9 @@ Sub BuildOptionsAndCosts() Call x.SHTp_Dump(res, ws.Name, ws.Cells(ws.Rows.Count, 16).End(xlUp).row, 16, False, True, 2) ' === 2. Get option costs === - sql = "SELECT * FROM rlarp.get_option_costs_priceg('" & Replace(pricegroup, "'", "''") & "') " & _ + sql = "SELECT * FROM rlarp.get_option_costs_priceg(" & _ + "'" & Replace(pricegroup, "'", "''") & "', " & _ + "'" & Replace(majg, "'", "''") & "') " & _ "ORDER BY branding, coltier, uomp;" res = x.ADOp_SelectS(0, sql, True, 10000, True, PostgreSQLODBC, _ "usmidsap02", False, "report", "report", "Port=5432;Database=ubm") @@ -517,6 +534,7 @@ Sub GetProductInfo() Dim sql As String Dim x As New TheBigOne Dim qry As Worksheet + Dim majg As String On Error GoTo HandleError @@ -526,6 +544,7 @@ Sub GetProductInfo() ' === Read product code from A5 === productCode = trim(ws.Cells(ROW_INPUT, COL_INPUT).value) volumeCode = trim(ws.Cells(8, 1).value) + majg = ws.Range("A14").value If productCode = "" Then MsgBox "Error: No product code provided in cell A5.", vbExclamation @@ -535,7 +554,8 @@ Sub GetProductInfo() ' === Build SQL to call Postgres function === sql = "SELECT * FROM rlarp.get_product_info(" & _ "'" & Replace(productCode, "'", "''") & "', " & _ - "'" & Replace(volumeCode, "'", "''") & "');" + "'" & Replace(volumeCode, "'", "''") & "', " & _ + "'" & Replace(majg, "'", "''") & "');" ' === Call Postgres === res = x.ADOp_SelectS(0, sql, True, 10000, True, PostgreSQLODBC, _