utilize new sql function

This commit is contained in:
Paul Trowbridge 2022-02-09 10:56:13 -05:00
parent 061dcbd9f4
commit 283e79714b
1 changed files with 85 additions and 15 deletions

100
FL.bas
View File

@ -793,7 +793,7 @@ Sub extract_price_matrix()
If Not login.proceed Then Exit Sub
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, login.tbU.Text, login.tbP.Text, "Port=5030;Database=ubm") Then
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm") Then
MsgBox ("not able to connect to CMS" & vbCrLf & x.ADOo_errstring)
Exit Sub
End If
@ -1012,7 +1012,7 @@ Sub extract_price_matrix_suff()
If Not login.proceed Then Exit Sub
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, login.tbU.Text, login.tbP.Text, "Port=5030;Database=ubm") Then
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm") Then
MsgBox ("not able to connect to CMS" & vbCrLf & x.ADOo_errstring)
Exit Sub
End If
@ -1209,9 +1209,9 @@ PRICELIST_SHOW:
If Not pricelist.proceed Then Exit Sub
pl_code = pricelist.cbLIST.value
pl_d1 = pricelist.tbD1.Text
pl_d2 = pricelist.tbD2.Text
pl_d3 = pricelist.tbD3.Text
pl_d1 = pricelist.tbD1.text
pl_d2 = pricelist.tbD2.text
pl_d3 = pricelist.tbD3.text
pl_action = Mid(pricelist.cbHDR.value, 1, 1)
dtl_action = Mid(pricelist.cbDTL.value, 1, 1)
@ -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
@ -1455,7 +1455,7 @@ Sub nursery_parse()
ext(3, 0) = "region"
For Each sh In Application.Worksheets
If InStr(sh.Name, "Price & Volume") > 0 Then
If InStr(sh.Name, "Price & Vol") > 0 Then
ReDim p(30)
ReDim m(30)
a = 6
@ -1533,13 +1533,13 @@ Sub nursery_parse()
Call tbo.SHTp_Dump(ext, "consolidated price list", 1, 1, False, True)
ext = tbo.TBLp_Transpose(ext)
sql = tbo.ADOp_BuildInsertSQL(ext, "rlarp.nregional", True, 1, UBound(ext, 2), Array("S", "S", "N", "S"))
sql = "truncate table rlarp.nregional;" & vbCrLf & sql & ";"
If Not tbo.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then
MsgBox (tbo.ADOo_errstring)
Else
MsgBox ("Uploaded")
End If
' sql = tbo.ADOp_BuildInsertSQL(ext, "rlarp.nregional", True, 1, UBound(ext, 2), Array("S", "S", "N", "S"))
' sql = "truncate table rlarp.nregional;" & vbCrLf & sql & ";"
' If Not tbo.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then
' MsgBox (tbo.ADOo_errstring)
' Else
' MsgBox ("Uploaded")
' End If
End Sub
@ -1561,15 +1561,85 @@ Sub pricegroup_upload()
Selection.CurrentRegion.Select
sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False)
sql = "BEGIN;" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";" & vbCrLf & "Commit;"
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, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then
MsgBox (x.ADOo_errstring)
Exit Sub
Else
'MsgBox ("Upload Complete")
End If
Call x.ADOp_CloseCon(0)
sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False)
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
MsgBox (x.ADOo_errstring)
Else
MsgBox ("Upload Complete")
End If
Call x.ADOp_CloseCon(0)
Set x = Nothing
End Sub
Sub pricegroup_upload_db2()
Dim sql As String
Selection.CurrentRegion.Select
Dim ulv() As Variant
Dim ul() As String
Dim i As Long
Dim inc As Long
ulv = Selection
ul = x.TBLp_VarToString(ulv)
ul = x.TBLp_Transpose(ul)
'sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2, False)
'sql = "BEGIN" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";" & vbCrLf & "END"
'Dim w As New Windows_API
'Call w.ClipBoard_SetData(sql)
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "PTROWBRIDG", "QQQX53@048") Then
MsgBox (x.ADOo_errstring)
Exit Sub
End If
If Not x.ADOp_Exec(0, "DELETE FROM rlarp.price_map") Then
MsgBox (x.ADOo_errstring)
Exit Sub
End If
'------------incremental upload----------------------
i = 2
inc = 250
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", "S", "S", "S"))
sql = x.SQLp_build_sql_values_ranged(ul, True, True, Db2, False, i, i + inc, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S")
sql = "INSERT INTO rlarp.price_map " & vbCrLf & sql
If Not x.ADOp_Exec(0, sql) Then
MsgBox (x.ADOo_errstring)
Call x.ADOp_CloseCon(0)
Exit Sub
End If
i = i + inc + 1
If i > UBound(ul, 2) Then Exit Do
If i + inc > UBound(ul, 2) Then inc = UBound(ul, 2) - i
Loop
MsgBox ("Upload Complete")
Call x.ADOp_CloseCon(0)
Set x = Nothing
End Sub