From c80e5296d17c88b77653e66587290e6325013030 Mon Sep 17 00:00:00 2001 From: Paul Trowbridge Date: Wed, 16 Jun 2021 09:03:23 -0400 Subject: [PATCH] add 2 subroutines and SQL formatting --- FL.bas | 141 ++++++++++++++++++++++++++++++++++++++++++++++---- TheBigOne.cls | 18 +++---- 2 files changed, 140 insertions(+), 19 deletions(-) diff --git a/FL.bas b/FL.bas index c747716..92d50ad 100644 --- a/FL.bas +++ b/FL.bas @@ -93,7 +93,7 @@ Sub ExtractPNC_CSV() Dim bal() As String Dim bali As Long Dim sched_loan As String - Dim P As FileDialog + Dim p As FileDialog Dim i As Long Dim j As Long Dim m As Long @@ -109,10 +109,10 @@ Sub ExtractPNC_CSV() '--------Open file------------- - Set P = Application.FileDialog(msoFileDialogOpen) - P.Show + Set p = Application.FileDialog(msoFileDialogOpen) + p.Show '--------Extract text---------- - f = x.FILEp_GetTXT(P.SelectedItems(1), 2000) + f = x.FILEp_GetTXT(p.SelectedItems(1), 2000) '--------resize arrays--------- ReDim col(11, UBound(f, 2)) @@ -190,11 +190,11 @@ Sub ExtractPNC_CSV() ' sh1.Name = "Collateral" ' sh2.Name = "Balance" - If Not x.FILEp_CreateCSV(Mid(P.SelectedItems(1), 1, Len(P.SelectedItems(1)) - 4) & "col.csv", col) Then + If Not x.FILEp_CreateCSV(Mid(p.SelectedItems(1), 1, Len(p.SelectedItems(1)) - 4) & "col.csv", col) Then MsgBox ("error") End If - If Not x.FILEp_CreateCSV(Mid(P.SelectedItems(1), 1, Len(P.SelectedItems(1)) - 4) & "bal.csv", bal) Then + If Not x.FILEp_CreateCSV(Mid(p.SelectedItems(1), 1, Len(p.SelectedItems(1)) - 4) & "bal.csv", bal) Then MsgBox ("error") End If @@ -721,13 +721,13 @@ Attribute pivot_field_format_1dec.VB_ProcData.VB_Invoke_Func = "M\n14" End Sub Sub Write_selection() - Dim P As FileDialog + Dim p As FileDialog '--------Open file------------- - Set P = Application.FileDialog(msoFileDialogSaveAs) - P.Show + Set p = Application.FileDialog(msoFileDialogSaveAs) + p.Show - Call x.FILEp_CreateTXT(P.SelectedItems(1), x.SHTp_Get(ActiveSheet.Name, Selection.row, Selection.column, False)) + Call x.FILEp_CreateTXT(p.SelectedItems(1), x.SHTp_Get(ActiveSheet.Name, Selection.row, Selection.column, False)) End Sub @@ -1531,3 +1531,124 @@ Sub price_load_pcore() End Sub +Sub price_issues() + + Dim x As New TheBigOne + Dim ilist() As String + Dim sql As String + + If ActiveSheet.Name <> "Issues" Then Exit Sub + + ilist = x.SHTp_Get(ActiveSheet.Name, 1, 1, True) + sql = "BEGIN;" & vbCrLf & "DELETE FROM rlarp.issues;" & vbCrLf & "INSERT INTO rlarp.issues" & vbCrLf + sql = sql & x.SQLp_build_sql_values(ilist, True, True, PostgreSQL, False, "S", "S", "S", "S") & ";" + sql = sql & vbCrLf & "END;" + + + If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then + MsgBox (x.ADOo_errstring) + End If + + Call x.ADOp_CloseCon(0) + + Set x = Nothing + +End Sub + +Sub nursery_parse() + + Dim tbo As New TheBigOne + Dim sh As Worksheet + Dim a As Long 'header row + Dim i As Long 'last row + Dim j As Long 'starting column + Dim c As Long 'customer column + Dim n As Long 'customer count + Dim x As Long 'max column + Dim b As Long 'ext part iterator + Dim z As Long 'ext all rows iterator + Dim partcol As Long 'part number column + Dim p() As Double 'log + Dim m() As String 'customer name + Dim ext() As String + Dim sql As String + + z = 0 + partcol = 2 + ReDim ext(3, 10000) + ext(0, 0) = "part" + ext(1, 0) = "customer" + ext(2, 0) = "price" + ext(3, 0) = "region" + + For Each sh In Application.Worksheets + If InStr(sh.Name, "Price & Volume") > 0 Then + ReDim p(30) + ReDim m(30) + a = 6 + '----find max row------------------------------------ + i = a + 1 + Do Until sh.Cells(i, 2) = "" Or i = 1000 + i = i + 1 + Loop + i = i - 1 + '----find starting column---------------------------- + j = 1 + Do Until sh.Cells(a, j) = "Order $" Or j = 1000 + j = j + 1 + Loop + c = 1 + '----identity price columns numbers------------------ + n = 0 + Do Until sh.Cells(a, c + j) = "" + If sh.Cells(a, c + j) = "NEW PRICE" Then + n = n + 1 + p(n) = c + j + End If + c = c + 1 + Loop + x = c + j + '----get the customer names-------------------------- + n = 0 + For c = j To x + If sh.Cells(a - 1, c) <> "" Then + n = n + 1 + m(n) = sh.Cells(a - 1, c) + End If + Next c + + '---resize arrays------ + ReDim Preserve p(n) + ReDim Preserve m(n) + + + '---for each customer loop through all the parts + For n = 1 To UBound(p) + For b = a + 1 To i + z = z + 1 + ext(0, z) = sh.Cells(b, partcol) + ext(1, z) = m(n) + ext(2, z) = sh.Cells(b, p(n)) + ext(3, z) = sh.Cells(2, 1) + Next b + Next n + Else + 'not a price tab + End If + + + Next sh + + ReDim Preserve ext(3, z) + Call tbo.TBLp_FilterSingle(ext, 2, "0", False) + Call tbo.TBLp_FilterSingle(ext, 2, "", False) + + 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 diff --git a/TheBigOne.cls b/TheBigOne.cls index 66b29ad..06531b4 100644 --- a/TheBigOne.cls +++ b/TheBigOne.cls @@ -2400,7 +2400,7 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he Set rx = CreateObject("vbscript.regexp") rx.Global = True - strip_text = "[^a-zA-Z0-9 \.\-\_\,\#\""]" + strip_text = "[^a-zA-Z0-9 \(\)\&\'\.\-\_\,\#\""]" strip_num = "[^0-9\.]" strip_date = "[^0-9\/\-\:\.]" @@ -2439,9 +2439,9 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he 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 & """" & rx.Replace(tbl(i, LBound(tbl, 2)), "") & """" + col_name = col_name & """" & Replace(rx.Replace(tbl(i, LBound(tbl, 2)), ""), "'", "''") & """" Else - col_name = col_name & rx.Replace(tbl(i, LBound(tbl, 2)), "") + col_name = col_name & Replace(rx.Replace(tbl(i, LBound(tbl, 2)), ""), "'", "''") End If Next i Else @@ -2461,7 +2461,7 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he If tbl(j, i) = "" Then rec = rec & "CAST(NULL AS NUMERIC)" Else - rec = rec & rx.Replace(tbl(j, i), "") + rec = rec & Replace(rx.Replace(tbl(j, i), ""), "'", "''") End If Case "S" '-------S = string------------------------------------------ rx.Pattern = strip_text @@ -2469,9 +2469,9 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he rec = rec & "CAST(NULL AS " & nullText & ")" Else If trim Then - rec = rec & "'" & LTrim(RTrim(rx.Replace(tbl(j, i), ""))) & "'" + rec = rec & "'" & Replace(LTrim(RTrim(rx.Replace(tbl(j, i), ""))), "'", "''") & "'" Else - rec = rec & "'" & rx.Replace(tbl(j, i), "") & "'" + rec = rec & "'" & Replace(rx.Replace(tbl(j, i), ""), "'", "''") & "'" End If End If @@ -2480,7 +2480,7 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he If LTrim(RTrim(tbl(j, i))) = "" Then rec = rec & "CAST(NULL AS DATE)" Else - rec = rec & "CAST('" & rx.Replace(tbl(j, i), "") & "' AS DATE)" + rec = rec & "CAST('" & Replace(rx.Replace(tbl(j, i), ""), "'", "''") & "' AS DATE)" End If Case Else '-------Assume text------------------------------------------ rx.Pattern = strip_text @@ -2488,9 +2488,9 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he rec = rec & "CAST(NULL AS " & nullText & ")" Else If trim Then - rec = rec & "'" & LTrim(RTrim(rx.Replace(tbl(j, i), ""))) & "'" + rec = rec & "'" & Replace(LTrim(RTrim(rx.Replace(tbl(j, i), ""))), "'", "''") & "'" Else - rec = rec & "'" & rx.Replace(tbl(j, i), "") & "'" + rec = rec & "'" & Replace(rx.Replace(tbl(j, i), ""), "'", "''") & "'" End If End If End Select