load table pcore from sheet contents

This commit is contained in:
Paul Trowbridge 2021-03-15 15:41:44 -04:00
parent fac0a38977
commit b1328fac50

78
FL.bas
View File

@ -1433,3 +1433,81 @@ PRICELIST_SHOW:
End Sub
Sub price_load_pcore()
Dim x As New TheBigOne 'function library
Dim sh As Worksheet 'target worksheet
Dim big() As String 'all price lists in one array
Dim load() As String 'individual price list to be loaded
Dim pcount As Long 'count of price list
Dim pcol() As Long 'hold the positions of each price list
ReDim pcol(30) 'size the array starting with 30 and trim later
Dim dcol() As Integer 'columns to be deleted
Dim typeflag() As String 'array of column types
Dim i As Long
Dim j As Long
Dim sql As String
'-------identify the active sheet and load the contents to an array-----------
Set sh = ActiveSheet
big = x.SHTp_Get(sh.Name, 3, 1, True)
'------iterate through the column headers to identify the price lists---------
pcount = 0
For i = 0 To UBound(big, 1)
If big(i, 0) = "plist" Then
pcount = pcount + 1
pcol(pcount) = i
End If
Next i
'------if no columns are labeled plist then exit------------------------------
If pcount = 0 Then Exit Sub
ReDim Preserve pcol(pcount)
ReDim typeflag(9)
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then
MsgBox (Err.Description)
Exit Sub
End If
'------prepare upload for each price list-------------------------------------
typeflag(0) = "S"
typeflag(1) = "S"
typeflag(2) = "S"
typeflag(3) = "S"
typeflag(4) = "S"
typeflag(5) = "S"
typeflag(6) = "N"
typeflag(7) = "N"
typeflag(8) = "N"
typeflag(9) = "S"
For pcount = 1 To UBound(pcol)
ReDim load(9, UBound(big, 2))
For i = 1 To UBound(big, 2)
load(0, i) = big(0, i)
load(1, i) = big(1, i)
load(2, i) = big(2, i)
load(3, i) = big(3, i)
load(4, i) = big(4, i)
load(5, i) = big(5, i)
load(6, i) = Format(big(pcol(pcount) - 3, i), "####0.00")
load(7, i) = Format(big(pcol(pcount) - 2, i), "####0.00")
load(8, i) = Format(big(pcol(pcount) - 1, i), "####0.00")
load(9, i) = big(pcol(pcount) - 0, i)
Next i
sql = x.SQLp_build_sql_values(load, True, False, PostgreSQL, False, "S", "S", "S", "S", "S", "S", "N", "N", "N", "S")
sql = "INSERT INTO rlarp.pcore" & vbCrLf & sql
If Not x.ADOp_Exec(0, sql) Then
MsgBox (x.ADOo_errstring)
Exit Sub
End If
Next pcount
End Sub