add 2 subroutines and SQL formatting
This commit is contained in:
parent
0101b45e8a
commit
c80e5296d1
141
FL.bas
141
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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user