update issues upload to merge and to target db2

This commit is contained in:
Paul Trowbridge 2022-08-04 16:47:39 -04:00
parent 24b91e4fb5
commit a55b719e94
1 changed files with 12 additions and 10 deletions

22
FL.bas
View File

@ -541,7 +541,7 @@ Sub sql_from_range_db2_noqh()
Dim wapi As New Windows_API
Dim r() As String
Selection.CurrentRegion.Select
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2, False))
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2, False, True))
End Sub
@ -561,13 +561,13 @@ Sub sql_from_range_pg_noqh()
Dim wapi As New Windows_API
Dim r() As String
Selection.CurrentRegion.Select
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False))
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, False))
End Sub
Sub auto_fit_range()
Selection.CurrentRegion.Columns.AutoFit
Selection.CurrentRegion.Columns.autofit
End Sub
@ -824,7 +824,7 @@ Sub extract_price_matrix()
Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
new_sh.Select
ActiveSheet.Cells(1, 1).CurrentRegion.Select
Selection.Columns.AutoFit
Selection.Columns.autofit
Rows("1:1").Select
With ActiveWindow
@ -1045,7 +1045,7 @@ Sub extract_price_matrix_suff()
Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
new_sh.Select
ActiveSheet.Cells(1, 1).CurrentRegion.Select
Selection.Columns.AutoFit
Selection.Columns.autofit
Rows("1:1").Select
With ActiveWindow
@ -1294,7 +1294,7 @@ PRICELIST_SHOW:
'--------Open file-------------
If Not x.FILEp_CreateCSV(pricelist.tbPATH.text & "\" & Replace(pl_code, ".", "_") & ".csv", ul) Then
If Not x.FILEp_CreateCSV(pricelist.tbPath.text & "\" & Replace(pl_code, ".", "_") & ".csv", ul) Then
MsgBox ("error")
End If
@ -1412,12 +1412,12 @@ Sub price_issues()
If ActiveSheet.Name <> "Issues" Then Exit Sub
ilist = x.SHTp_Get(ActiveSheet.Name, 1, 1, True)
sql = "BEGIN;" & vbCrLf & "DELETE FROM rlarp.issues;" & vbCrLf & "INSERT INTO rlarp.issues" & vbCrLf
sql = sql & x.SQLp_build_sql_values(ilist, True, True, PostgreSQL, False, "S", "S", "S", "S") & ";"
sql = sql & vbCrLf & "END;"
sql = "MERGE INTO RLARP.ISSUES i USING (" & vbCrLf
sql = sql & x.SQLp_build_sql_values(ilist, True, True, Db2, False, True, "N", "N", "S", "D")
sql = sql & vbCrLf & ") x ON" & vbCrLf & " x.ordern = i.ordern" & vbCrLf & " AND x.linen = i.linen" & vbCrLf & "WHEN MATCHED THEN UPDATE SET" & vbCrLf & " i.issue = x.issue" & vbCrLf & " ,i.odate = x.odate" & vbCrLf & "WHEN NOT MATCHED THEN INSERT VALUES (" & vbCrLf & " x.ordern , x.linen, x.issue, x.odate" & vbCrLf & ")"
If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then
If Not x.ADOp_Exec(0, sql, 1, True, ISeries, "s7830956", False, "ptrowbridg", "qqqx53@048") Then
MsgBox (x.ADOo_errstring)
End If
@ -1659,3 +1659,5 @@ Sub clear_page_breaks()
Next b
End Sub