Compare commits
No commits in common. "283e79714b81bd0523e69dff884982cf417a4822" and "a448efe0b177c54c62528803c118284a453eaa49" have entirely different histories.
283e79714b
...
a448efe0b1
100
FL.bas
100
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_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 & Vol") > 0 Then
|
||||
If InStr(sh.Name, "Price & Volume") > 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,85 +1561,15 @@ 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
|
||||
|
||||
158
TheBigOne.cls
158
TheBigOne.cls
@ -2114,7 +2114,6 @@ 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
|
||||
|
||||
@ -2123,10 +2122,9 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, tri
|
||||
rec = ""
|
||||
If i <> start 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 ftype(0)(k)
|
||||
For j = 0 To UBound(tbl, 1)
|
||||
If j <> 0 Then rec = rec & ","
|
||||
Select Case ftype(0)(j)
|
||||
Case "N" '-------N = numeric but should probably be N for numeric----
|
||||
If tbl(j, i) = "" Then
|
||||
rec = rec & "NULL"
|
||||
@ -2152,7 +2150,6 @@ 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
|
||||
@ -2418,7 +2415,6 @@ 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
|
||||
@ -2493,10 +2489,9 @@ 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(k)
|
||||
Select Case type_flag(j)
|
||||
Case "N" '-------N = numeric but should probably be N for numeric----
|
||||
rx.Pattern = strip_num
|
||||
If tbl(j, i) = "" Then
|
||||
@ -2535,7 +2530,6 @@ 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
|
||||
@ -2556,150 +2550,6 @@ 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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user