utilize new sql function

FL.bas

@@ -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_d1 = pricelist.tbD1.text
-    pl_d2 = pricelist.tbD2.Text
+    pl_d2 = pricelist.tbD2.text
-    pl_d3 = pricelist.tbD3.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 = tbo.ADOp_BuildInsertSQL(ext, "rlarp.nregional", True, 1, UBound(ext, 2), Array("S", "S", "N", "S"))
-    sql = "truncate table rlarp.nregional;" & vbCrLf & sql & ";"
+'    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
+'    If Not tbo.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then
-        MsgBox (tbo.ADOo_errstring)
+'        MsgBox (tbo.ADOo_errstring)
-    Else
+'    Else
-        MsgBox ("Uploaded")
+'        MsgBox ("Uploaded")
-    End If
+'    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

TheBigOne.cls

@@ -2114,6 +2114,7 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, tri
     
     Dim i As Long
     Dim j As Long
+    Dim k As Long
     Dim sql As String
     Dim rec As String
     
@@ -2122,9 +2123,10 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, tri
         rec = ""
         If i <> start Then sql = sql & "," & vbCrLf
         rec = rec & "("
-        For j = 0 To UBound(tbl, 1)
+        k = 0
-            If j <> 0 Then rec = rec & ","
+        For j = LBound(tbl, 1) To UBound(tbl, 1)
-            Select Case ftype(0)(j)
+            If j <> LBound(tbl, 1) Then rec = rec & ","
+            Select Case ftype(0)(k)
                 Case "N"    '-------N = numeric but should probably be N for numeric----
                     If tbl(j, i) = "" Then
                         rec = rec & "NULL"
@@ -2150,6 +2152,7 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, tri
                         rec = rec & "'" & Replace(tbl(j, i), "'", "''") & "'"
                     End If
             End Select
+            k = k + 1
         Next j
         rec = rec & ")"
         sql = sql & rec
@@ -2415,6 +2418,7 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
     
     Dim i As Long
     Dim j As Long
+    Dim k As Long
     Dim sql As String
     Dim rec As String
     Dim type_flag() As String
@@ -2489,9 +2493,10 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
         rec = ""
         If i <> start_row Then sql = sql & "," & vbCrLf
         rec = rec & "("
+        k = 0
         For j = LBound(tbl, 1) To UBound(tbl, 1)
             If j <> LBound(tbl, 1) Then rec = rec & ","
-            Select Case type_flag(j)
+            Select Case type_flag(k)
                 Case "N"    '-------N = numeric but should probably be N for numeric----
                     rx.Pattern = strip_num
                     If tbl(j, i) = "" Then
@@ -2530,6 +2535,7 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
                         End If
                     End If
             End Select
+            k = k + 1
         Next j
         rec = rec & ")"
         sql = sql & rec
@@ -2550,6 +2556,150 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
 
 End Function
 
+Public Function SQLp_build_sql_values_ranged(ByRef tbl() As String, trim As Boolean, headers As Boolean, syntax As SQLsyntax, ByRef quote_headers As Boolean, start_row As Long, end_row As Long, ParamArray typeflag()) As String
+
+    
+    Dim i As Long
+    Dim j As Long
+    Dim k As Long
+    Dim sql As String
+    Dim rec As String
+    Dim type_flag() As String
+    Dim col_name As String
+    Dim header_row As Long
+    Dim rx As Object
+    Dim strip_text As String
+    Dim strip_num As String
+    Dim strip_date As String
+    Dim nullText As String
+    
+    If syntax = PostgreSQL Then
+        nullText = "text"
+    Else
+        nullText = "varchar(255)"
+    End If
+    
+    
+    Set rx = CreateObject("vbscript.regexp")
+    rx.Global = True
+    
+    strip_text = "[^a-zA-Z0-9 \(\)\&\'\.\-\_\,\#\""\:]"
+    strip_num = "[^0-9\.]"
+    strip_date = "[^0-9\/\-\:\.]"
+    
+    '------if a type flag array has been supplied copy its contents---------------
+    If UBound(typeflag) <> -1 Then
+        ReDim type_flag(UBound(typeflag))
+        For i = 0 To UBound(typeflag)
+            type_flag(i) = typeflag(i)
+        Next i
+    Else
+        ReDim type_flag(UBound(tbl, 1))
+        For j = LBound(tbl, 1) To UBound(tbl, 1)
+            If IsNumeric(tbl(j, LBound(tbl, 2) + 1)) Then
+                    If InStr(1, tbl(j, 1), ".") > 0 Then
+                        type_flag(j) = "N"
+                    Else
+                        type_flag(j) = "S"
+                    End If
+                Else
+                    If Len(tbl(j, 1)) >= 6 Then
+                        If IsDate(tbl(j, 1)) Then
+                            type_flag(j) = "D"
+                        Else
+                            type_flag(j) = "S"
+                        End If
+                    Else
+                        type_flag(j) = "S"
+                    End If
+                End If
+        Next j
+    End If
+    
+    rx.Pattern = strip_text
+    If headers Then
+        header_row = LBound(tbl, 2) + 1
+        For i = LBound(tbl, 1) To UBound(tbl, 1)
+            If i > LBound(tbl, 1) Then col_name = col_name & ","
+            If quote_headers Then
+                col_name = col_name & """" & Replace(rx.Replace(tbl(i, LBound(tbl, 2)), ""), "'", "''") & """"
+            Else
+                col_name = col_name & Replace(rx.Replace(tbl(i, LBound(tbl, 2)), ""), "'", "''")
+            End If
+        Next i
+    Else
+        header_row = LBound(tbl, 2)
+    End If
+
+
+    For i = start_row To end_row
+        rec = ""
+        If i <> start_row Then sql = sql & "," & vbCrLf
+        rec = rec & "("
+        k = 0
+        For j = LBound(tbl, 1) To UBound(tbl, 1)
+            If j <> LBound(tbl, 1) Then rec = rec & ","
+            Select Case type_flag(k)
+                Case "N"    '-------N = numeric but should probably be N for numeric----
+                    rx.Pattern = strip_num
+                    If tbl(j, i) = "" Then
+                        rec = rec & "CAST(NULL AS NUMERIC)"
+                    Else
+                        rec = rec & Replace(rx.Replace(tbl(j, i), ""), "'", "''")
+                    End If
+                Case "S"    '-------S = string------------------------------------------
+                    rx.Pattern = strip_text
+                    If LTrim(RTrim(tbl(j, i))) = "" Then
+                        rec = rec & "CAST(NULL AS " & nullText & ")"
+                    Else
+                        If trim Then
+                            rec = rec & "'" & Replace(LTrim(RTrim(rx.Replace(tbl(j, i), ""))), "'", "''") & "'"
+                        Else
+                            rec = rec & "'" & Replace(rx.Replace(tbl(j, i), ""), "'", "''") & "'"
+                            
+                        End If
+                    End If
+                Case "D"    '-------D = date---------------------------------------------
+                    rx.Pattern = strip_date
+                    If LTrim(RTrim(tbl(j, i))) = "" Then
+                        rec = rec & "CAST(NULL AS DATE)"
+                    Else
+                        rec = rec & "CAST('" & Replace(rx.Replace(tbl(j, i), ""), "'", "''") & "' AS DATE)"
+                    End If
+                Case Else   '-------Assume text------------------------------------------
+                    rx.Pattern = strip_text
+                    If LTrim(RTrim(tbl(j, i))) = "" Then
+                        rec = rec & "CAST(NULL AS " & nullText & ")"
+                    Else
+                        If trim Then
+                            rec = rec & "'" & Replace(LTrim(RTrim(rx.Replace(tbl(j, i), ""))), "'", "''") & "'"
+                        Else
+                            rec = rec & "'" & Replace(rx.Replace(tbl(j, i), ""), "'", "''") & "'"
+                        End If
+                    End If
+            End Select
+            k = k + 1
+        Next j
+        rec = rec & ")"
+        sql = sql & rec
+    Next i
+    '---------build select--------------------------
+    Select Case syntax
+        Case SQLsyntax.Db2
+            sql = "SELECT * FROM TABLE( VALUES" & vbCrLf & sql & vbCrLf & ") x"
+        Case SQLsyntax.SqlServer
+            sql = "SELECT * FROM (VALUES" & vbCrLf & sql & vbCrLf & ") x"
+        Case SQLsyntax.PostgreSQL
+            sql = "SELECT * FROM (VALUES" & vbCrLf & sql & vbCrLf & ") x"
+    End Select
+    
+    If headers Then sql = sql & "(" & col_name & ")"
+    '---------final assignment----------------------
+    SQLp_build_sql_values_ranged = sql
+
+End Function
+
+
 Public Function ARRAYp_get_range_string(ByRef r As Range) As String()
 
     Dim i As Long