pt/VBA
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

handle empty diretories and point to new server

Browse Source
This commit is contained in:
Paul Trowbridge 2023-09-19 12:00:34 -04:00
parent da1df9337c
commit 758f35cecd
1 changed files with 17 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
targets.bas
View File

@ -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)