pt/VBA
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

include a new data type flag to prevent running regex on special characters that should be retained instead of removed

Browse Source
This commit is contained in:
Paul Trowbridge 2022-03-31 12:35:18 -04:00
parent 283e79714b
commit 3ce9b371ca
2 changed files with 18 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
FL.bas
View File

@ -1560,7 +1560,7 @@ Sub pricegroup_upload()
Dim sql As String Dim sql As String
Selection.CurrentRegion.Select Selection.CurrentRegion.Select
sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False) sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, "S", "S", "S", "S", "S", "S", "S", "S", "S", "N", "S", "S", "S", "A")
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 If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then
@ -1572,7 +1572,7 @@ Sub pricegroup_upload()
Call x.ADOp_CloseCon(0) Call x.ADOp_CloseCon(0)
sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False) sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, "S", "S", "S", "S", "S", "S", "S", "S", "S", "N", "S", "S", "S", "A")
sql = "BEGIN" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";" & vbCrLf & "END" 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 If Not x.ADOp_Exec(0, sql, 1, True, ADOinterface.SqlServer, "usmidsql01", True) Then
@ -1585,6 +1585,8 @@ Sub pricegroup_upload()
Set x = Nothing Set x = Nothing
Call pricegroup_upload_db2
End Sub End Sub
@ -1622,8 +1624,8 @@ Sub pricegroup_upload_db2()
i = 2 i = 2
inc = 250 inc = 250
Do While i <= UBound(ul, 2) 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.ADOp_BuildInsertSQL(ul, "rlarp.price_map", True, i, WorksheetFunction.Min(i + inc, UBound(ul, 2)), Array("S", "S", "S", "S", "S", "S", "S", "N", "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 = x.SQLp_build_sql_values_ranged(ul, True, True, Db2, False, i, i + inc, "S", "S", "S", "S", "S", "S", "S", "S", "S", "N", "S", "S", "S", "A")
sql = "INSERT INTO rlarp.price_map " & vbCrLf & sql sql = "INSERT INTO rlarp.price_map " & vbCrLf & sql
If Not x.ADOp_Exec(0, sql) Then If Not x.ADOp_Exec(0, sql) Then
MsgBox (x.ADOo_errstring) MsgBox (x.ADOo_errstring)

12
TheBigOne.cls
View File

@ -2514,6 +2514,18 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
Else Else
rec = rec & "'" & Replace(rx.Replace(tbl(j, i), ""), "'", "''") & "'" rec = rec & "'" & Replace(rx.Replace(tbl(j, i), ""), "'", "''") & "'"
End If
End If
Case "A" '-------A = string but dont apply any regex------------------
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(tbl(j, i))), "'", "''") & "'"
Else
rec = rec & "'" & Replace(tbl(j, i), "'", "''") & "'"
End If End If
End If End If
Case "D" '-------D = date--------------------------------------------- Case "D" '-------D = date---------------------------------------------