add function

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