From 758f35cecd6ea02e18d28b5321ce86f8c65a3d58 Mon Sep 17 00:00:00 2001 From: Paul Trowbridge Date: Tue, 19 Sep 2023 12:00:34 -0400 Subject: [PATCH] handle empty diretories and point to new server --- targets.bas | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/targets.bas b/targets.bas index e68c029..d6c3722 100644 --- a/targets.bas +++ b/targets.bas @@ -24,12 +24,12 @@ Sub get_options() '----------------get the available options from all the parts setup in the item master---------------------------------------------- sql = "SELECT * FROM rlarp.get_options('" & mold & "');" - res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "10.56.60.254", False, "report", "report", "Port=5432;Database=ubm") + res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm") ws.Range("N1:ZZ3500").ClearContents '----------------get the options already set if this item has been setup------------------------------------------------------------ fpath = Sheets("env").Range("B1").value & "\" & Sheets("combine").Range("A2").value & "\options.csv" - If Len(Dir(fpath)) > 0 Then + If DirectoryExists(fpath) Then onfile = x.FILEp_GetCSV(fpath) Call x.ARRAYp_Transpose(onfile) 'merge all the options from the item master and the saved options @@ -57,18 +57,25 @@ Sub get_options() End If sql = "SELECT * FROM rlarp.get_option_costs('" & mold & "') ORDER BY branding, coltier, uomp;" - res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "10.56.60.254", False, "report", "report", "Port=5432;Database=ubm") + res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm") ws.Range("C1:L350").ClearContents - Call x.SHTp_Dump(res, ws.Name, 1, 3, False, True, 8) + Call x.SHTp_Dump(res, ws.Name, 1, 3, False, True, 9, 10, 11) Call x.ADOp_CloseCon(0) - - - - End Sub +Function DirectoryExists(directory As String) As Boolean + On Error GoTo ErrorHandler + Dim tempDir As String + tempDir = Dir(directory, vbDirectory) + DirectoryExists = (tempDir <> "") + Exit Function +ErrorHandler: + 'If there is any error (e.g. invalid path), return False + DirectoryExists = False +End Function + Sub combine_options() Dim mold As String @@ -89,7 +96,7 @@ Sub combine_options() json = x.json_from_table(stackv, "", False) sql = "SELECT * FROM rlarp.set_options($$" & vbCrLf & json & vbCrLf & "$$::jsonb)" - res = x.ADOp_SelectS(0, sql, True, 5000, True, PostgreSQLODBC, "10.56.60.254", False, "report", "report", "Port=5432;Database=ubm") + res = x.ADOp_SelectS(0, sql, True, 5000, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm") Call x.ADOp_CloseCon(0) ws.Range("S1:AC5000").ClearContents @@ -165,7 +172,7 @@ Sub save_targets() Exit Sub End If - If Not x.ADOp_Exec(0, sqlt, 1, True, PostgreSQLODBC, "usmidsap01", False, "report", "report", "Port=5432;Database=ubm") Then + If Not x.ADOp_Exec(0, sqlt, 1, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm") Then MsgBox (x.ADOo_errstring) Else Call x.ADOp_CloseCon(0)