diff --git a/TheBigOne.cls b/TheBigOne.cls index eb6dbe4..ff73c69 100644 --- a/TheBigOne.cls +++ b/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) - If j <> 0 Then rec = rec & "," - Select Case ftype(0)(j) + k = 0 + For j = LBound(tbl, 1) To UBound(tbl, 1) + 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