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

vault backup: 2024-02-19 10:59:47

Browse Source
This commit is contained in:
Paul Trowbridge 2024-02-19 10:59:47 -05:00
parent e2533d2c45
commit faf78de0c5
1 changed files with 45 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
FL.bas
View File

@ -1341,7 +1341,7 @@ Sub price_load_pcore()
ReDim Preserve pcol(pcount) ReDim Preserve pcol(pcount)
ReDim typeflag(9) ReDim typeflag(9)
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.0.10.40", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then
MsgBox (Err.Description) MsgBox (Err.Description)
Exit Sub Exit Sub
End If End If
@ -1439,7 +1439,7 @@ Sub price_load_pcore_one()
ReDim Preserve pcol(pcount) ReDim Preserve pcol(pcount)
ReDim typeflag(9) ReDim typeflag(9)
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.0.10.40", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then
MsgBox (Err.Description) MsgBox (Err.Description)
Exit Sub Exit Sub
End If End If
@ -1659,32 +1659,42 @@ Sub pricegroup_upload()
Dim sql As String Dim sql As String
Selection.CurrentRegion.Select Selection.CurrentRegion.Select
sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "J") '---------------------------postgres------------------------------
sql = "BEGIN;" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";" & vbCrLf & "COMMIT;"
If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "10.56.60.254", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "J")
sql = "BEGIN;" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";"
sql = sql & vbCrLf & "REFRESH MATERIALIZED VIEW rlarp.molds;"
sql = sql & vbCrLf & "COMMIT;"
If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidsap02", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then
MsgBox (x.ADOo_errstring) MsgBox (x.ADOo_errstring)
Exit Sub Exit Sub
Else Else
'MsgBox ("Upload Complete") 'MsgBox ("Upload Complete")
End If End If
Call x.ADOp_CloseCon(0) Call x.ADOp_CloseCon(0)
'Exit Sub
sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "J") '---------------------------sql server------------------------------
sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "A")
sql = "BEGIN" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";" & vbCrLf & "END" sql = "BEGIN" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";" & vbCrLf & "END"
If Not x.ADOp_Exec(0, sql, 1, True, ADOinterface.SqlServer, "usmidsql01", True) Then If Not x.ADOp_Exec(1, sql, 1, True, ADOinterface.SqlServer, "usmidsql01", True) Then
MsgBox (x.ADOo_errstring) MsgBox (x.ADOo_errstring)
Else Else
'MsgBox ("Upload Complete") 'MsgBox ("Upload Complete")
End If End If
Call x.ADOp_CloseCon(0) Call x.ADOp_CloseCon(1)
Set x = Nothing Set x = Nothing
'Call pricegroup_upload_db2 '---------------------------iSeries------------------------------
Call pricegroup_upload_db2
MsgBox ("Upload Complete") MsgBox ("Upload Complete")
@ -1725,7 +1735,7 @@ Sub pricegroup_upload_db2()
inc = 250 inc = 250
Do While i <= UBound(ul, 2) Do While i <= UBound(ul, 2)
'sql = x.ADOp_BuildInsertSQL(ul, "rlarp.price_map", True, i, WorksheetFunction.Min(i + inc, UBound(ul, 2)), Array("S", "S", "S", "S", "S", "S", "S", "N", "S", "S")) 'sql = x.ADOp_BuildInsertSQL(ul, "rlarp.price_map", True, i, WorksheetFunction.Min(i + inc, UBound(ul, 2)), Array("S", "S", "S", "S", "S", "S", "S", "N", "S", "S"))
sql = x.SQLp_build_sql_values_ranged(ul, True, True, Db2, False, True, i, i + inc, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "A") sql = x.SQLp_build_sql_values_ranged(ul, False, True, Db2, False, True, i, i + inc, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "A")
sql = "INSERT INTO rlarp.price_map " & vbCrLf & sql sql = "INSERT INTO rlarp.price_map " & vbCrLf & sql
If Not x.ADOp_Exec(0, sql) Then If Not x.ADOp_Exec(0, sql) Then
MsgBox (x.ADOo_errstring) MsgBox (x.ADOo_errstring)
@ -1900,7 +1910,7 @@ Sub load_ffterr()
If Not login.proceed Then Exit Sub If Not login.proceed Then Exit Sub
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, login.tbU, login.tbP, "database=ubm") Then If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.0.10.40", False, login.tbU, login.tbP, "database=ubm") Then
MsgBox (x.ADOo_errstring) MsgBox (x.ADOo_errstring)
Exit Sub Exit Sub
End If End If
@ -1953,7 +1963,7 @@ Sub load_csrca()
If Not login.proceed Then Exit Sub If Not login.proceed Then Exit Sub
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, login.tbU, login.tbP, "database=ubm") Then If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.0.10.40", False, login.tbU, login.tbP, "database=ubm") Then
MsgBox (x.ADOo_errstring) MsgBox (x.ADOo_errstring)
Exit Sub Exit Sub
End If End If
@ -1980,7 +1990,7 @@ Sub load_prm()
If Not login.proceed Then Exit Sub If Not login.proceed Then Exit Sub
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, login.tbU, login.tbP, "database=ubm") Then If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.0.10.40", False, login.tbU, login.tbP, "database=ubm") Then
MsgBox (x.ADOo_errstring) MsgBox (x.ADOo_errstring)
Exit Sub Exit Sub
End If End If
@ -2003,19 +2013,26 @@ Sub load_qrh()
Dim x As New TheBigOne Dim x As New TheBigOne
Dim sql As String Dim sql As String
'---------------postgrs-------------------
login.Caption = "Postgres Creds" login.Caption = "Postgres Creds"
login.Show login.Show
If Not login.proceed Then Exit Sub If Not login.proceed Then Exit Sub
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, login.tbU, login.tbP, "database=ubm") Then If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.0.10.40", False, login.tbU, login.tbP, "database=ubm") Then
MsgBox (x.ADOo_errstring) MsgBox (x.ADOo_errstring)
Exit Sub Exit Sub
End If End If
Call x.ADOp_CloseCon(0)
'---------------iSereis-------------------
login.Caption = "iSeries Creds" login.Caption = "iSeries Creds"
login.Show login.Show
If Not login.proceed Then Exit Sub If Not login.proceed Then Exit Sub
If Not x.ADOp_OpenCon(1, ISeries, "S7830956", False, login.tbU, login.tbP) Then If Not x.ADOp_OpenCon(1, ISeries, "S7830956", False, login.tbU, login.tbP) Then
MsgBox (x.ADOo_errstring) MsgBox (x.ADOo_errstring)
Exit Sub Exit Sub
@ -2025,16 +2042,23 @@ Sub load_qrh()
sql = sql & vbLf & x.SQLp_build_sql_values(x.SHTp_Get("qrh", 1, 1, True), False, True, PostgreSQL, False, True, "A", "A") & ";" sql = sql & vbLf & x.SQLp_build_sql_values(x.SHTp_Get("qrh", 1, 1, True), False, True, PostgreSQL, False, True, "A", "A") & ";"
sql = sql & vbLf & "DELETE FROM rlarp.qrh; INSERT INTO rlarp.qrh SELECT * FROM import.qrh; END;" sql = sql & vbLf & "DELETE FROM rlarp.qrh; INSERT INTO rlarp.qrh SELECT * FROM import.qrh; END;"
If Not x.ADOp_Exec(0, sql) Then If Not x.ADOp_Exec(1, sql) Then
MsgBox (x.ADOo_errstring) MsgBox (x.ADOo_errstring)
Exit Sub Exit Sub
End If End If
'---------------mssql-------------------
sql = "BEGIN DELETE FROM RLARP.QRH; INSERT INTO RLARP.QRH" & vbCrLf sql = "BEGIN DELETE FROM RLARP.QRH; INSERT INTO RLARP.QRH" & vbCrLf
sql = sql & x.SQLp_build_sql_values(x.SHTp_Get("qrh", 1, 1, True), True, True, Db2, False, True, "A", "A") & ";" sql = sql & x.SQLp_build_sql_values(x.SHTp_Get("qrh", 1, 1, True), True, True, SqlServer, False, True, "A", "A") & ";"
sql = sql & vbCrLf & " END" sql = sql & vbCrLf & " END"
If Not x.ADOp_Exec(1, sql) Then If Not x.ADOp_OpenCon(2, SqlServer, "usmidsap01", True) Then
MsgBox (x.ADOo_errstring)
Exit Sub
End If
If Not x.ADOp_Exec(2, sql) Then
MsgBox (x.ADOo_errstring) MsgBox (x.ADOo_errstring)
Exit Sub Exit Sub
End If End If