VBA/handler.bas

Option Explicit

Public sql As String
Public jsql As String
Public scenario As String
Public sc() As Variant
Public x As New TheBigOne
Public wapi As New Windows_API
Public data() As String
Public agg() As String
Public showprice As Boolean
Public server As String


Sub load_fpvt()

    Application.StatusBar = "retrieving selection data....."
    
    'data = x.SHTp_Get("data", 1, 1, True)
    'Call x.TBLp_Aggregate(data, True, True, True, Array(1, 3), Array("S", "S"), Array(30))
    Dim i As Long
    Dim s_tot As Object
    
    fpvt.ListBox1.list = handler.sc
    
    showprice = False
    
    For i = 0 To UBound(handler.sc, 1)
        If handler.sc(i, 0) = "part_descr" Then
            showprice = True
            Exit For
        End If
    Next i
    
    If showprice Then
        fpvt.opvolume.Visible = False
        fpvt.opprice.Visible = False
        fpvt.tbAdjPrice.BackColor = &H80000005
        fpvt.tbAdjVol.BackColor = &H80000005
        fpvt.tbAdjVal.BackColor = &H80000004
        fpvt.tbAdjVal.Enabled = False
        fpvt.tbAdjPrice.Enabled = True
        fpvt.tbAdjVol.Enabled = True
    Else
        fpvt.opvolume.Visible = True
        fpvt.opprice.Visible = True
        fpvt.tbAdjPrice.BackColor = &H80000003
        fpvt.tbAdjVol.BackColor = &H80000003
        fpvt.tbAdjVal.BackColor = &H80000005
        fpvt.tbAdjVal.Enabled = True
        fpvt.tbAdjPrice.Enabled = False
        fpvt.tbAdjVol.Enabled = False
    End If
    
    
    fpvt.Show
    
    
    


End Sub

Function request_adjust(doc As String) As Object

    Dim req As New WinHttp.WinHttpRequest
    Dim json As Object
    Dim wr As String
    
    With req
        '.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
        '.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
        .Open "GET", "http://localhost:3000/request_adjust", True
        .SetRequestHeader "Content-Type", "application/json"
        .Send doc
        .WaitForResponse
        wr = .ResponseText
    End With

    Set json = JsonConverter.ParseJson(wr)
    Set scenario_totals = json
    
End Function



Function scenario_totals(doc As String, ByRef status As Boolean) As Object

    Dim req As New WinHttp.WinHttpRequest
    Dim json As Object
    Dim wr As String
    
    On Error GoTo errh
    
    With req
        '.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
        .Open "GET", "http://10.56.1.15:3000/scenario_totals", True
        '.Open "GET", "http://localhost:3000/scenario_totals", True
        .SetRequestHeader "Content-Type", "application/json"
        .Send doc
        .WaitForResponse
        wr = .ResponseText
    End With

    Set json = JsonConverter.ParseJson(wr)
    Set scenario_totals = json
    
errh:
    If Err.Number <> 0 Then
        status = False
        MsgBox (Err.Description)
        Set scenario_totals = Nothing
    Else
        status = True
    End If
    
End Function

Function scenario_package(doc As String, ByRef status As Boolean) As Object

    Dim req As New WinHttp.WinHttpRequest
    Dim json As Object
    Dim wr As String
    
    On Error GoTo errh
    
    With req
        .Open "GET", server & "/scenario_package", True
        .SetRequestHeader "Content-Type", "application/json"
        .Send doc
        .WaitForResponse
        wr = .ResponseText
    End With

    Set json = JsonConverter.ParseJson(wr)
    Set scenario_package = json
    
errh:
    If Err.Number <> 0 Then
        status = False
        MsgBox (Err.Description)
        Set scenario_package = Nothing
    Else
        status = True
    End If
    
End Function

Sub pg_main_workset(rep As String)

    Dim req As New WinHttp.WinHttpRequest
    Dim wapi As New Windows_API
    Dim wr As String
    Dim json As Object
    Dim i As Long
    Dim j As Long
    Dim doc As String
    Dim res() As Variant
    Dim str() As String
    
    doc = "{""quota_rep"":""" & rep & """}"
         
    With req
        .Open "GET", server & "/get_pool", True
        .SetRequestHeader "Content-Type", "application/json"
        .Send doc
        .WaitForResponse
        wr = .ResponseText
    End With

    Set json = JsonConverter.ParseJson(wr)
    ReDim res(json("x").Count, 32)
    
    For i = 1 To UBound(res, 1)
        res(i, 0) = json("x")(i)("bill_cust_descr")
        res(i, 1) = json("x")(i)("billto_group")
        res(i, 2) = json("x")(i)("ship_cust_descr")
        res(i, 3) = json("x")(i)("shipto_group")
        res(i, 4) = json("x")(i)("quota_rep_descr")
        res(i, 5) = json("x")(i)("director_descr")
        res(i, 6) = json("x")(i)("segm")
        res(i, 7) = json("x")(i)("mod_chan")
        res(i, 8) = json("x")(i)("mod_chansub")
        res(i, 9) = json("x")(i)("majg_descr")
        res(i, 10) = json("x")(i)("ming_descr")
        res(i, 11) = json("x")(i)("majs_descr")
        res(i, 12) = json("x")(i)("mins_descr")
        res(i, 13) = json("x")(i)("brand")
        res(i, 14) = json("x")(i)("part_family")
        res(i, 15) = json("x")(i)("part_group")
        res(i, 16) = json("x")(i)("branding")
        res(i, 17) = json("x")(i)("color")
        res(i, 18) = json("x")(i)("part_descr")
        res(i, 19) = json("x")(i)("order_season")
        res(i, 20) = json("x")(i)("order_month")
        res(i, 21) = json("x")(i)("ship_season")
        res(i, 22) = json("x")(i)("ship_month")
        res(i, 23) = json("x")(i)("request_season")
        res(i, 24) = json("x")(i)("request_month")
        res(i, 25) = json("x")(i)("promo")
        res(i, 26) = json("x")(i)("version")
        res(i, 27) = json("x")(i)("iter")
        res(i, 28) = json("x")(i)("value_loc")
        res(i, 29) = json("x")(i)("value_usd")
        res(i, 30) = json("x")(i)("cost_loc")
        res(i, 31) = json("x")(i)("cost_usd")
        res(i, 32) = json("x")(i)("units")
    Next i
    
    res(0, 0) = "bill_cust_descr"
    res(0, 1) = "billto_group"
    res(0, 2) = "ship_cust_descr"
    res(0, 3) = "shipto_group"
    res(0, 4) = "quota_rep_descr"
    res(0, 5) = "director_descr"
    res(0, 6) = "segm"
    res(0, 7) = "mod_chan"
    res(0, 8) = "mod_chansub"
    res(0, 9) = "majg_descr"
    res(0, 10) = "ming_descr"
    res(0, 11) = "majs_descr"
    res(0, 12) = "mins_descr"
    res(0, 13) = "brand"
    res(0, 14) = "part_family"
    res(0, 15) = "part_group"
    res(0, 16) = "branding"
    res(0, 17) = "color"
    res(0, 18) = "part_descr"
    res(0, 19) = "order_season"
    res(0, 20) = "order_month"
    res(0, 21) = "ship_season"
    res(0, 22) = "ship_month"
    res(0, 23) = "request_season"
    res(0, 24) = "request_month"
    res(0, 25) = "promo"
    res(0, 26) = "version"
    res(0, 27) = "iter"
    res(0, 28) = "value_loc"
    res(0, 29) = "value_usd"
    res(0, 30) = "cost_loc"
    res(0, 31) = "cost_usd"
    res(0, 32) = "units"

    
    Set json = Nothing

    ReDim str(UBound(res, 1), UBound(res, 2))
    
    For i = 0 To UBound(res, 1)
        For j = 0 To UBound(res, 2)
            If IsNull(res(i, j)) Then
                str(i, j) = ""
            Else
                str(i, j) = res(i, j)
            End If
        Next j
    Next i
    
    Call x.SHTp_Dump(str, "data", 1, 1, True, False, 28, 29, 30, 31, 32)

End Sub

Sub pull_rep()

    openf.Show

End Sub

Sub test()

    Dim req As New WinHttp.WinHttpRequest
    Dim json As Object
    Dim wr As String
    

    
    With req
        '.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
        '.Open "GET", "http://10.56.1.15:3000/scenario_package", True
        .Open "GET", "http://localhost:3000/scenario_package", True
        .SetRequestHeader "Content-Type", "application/json"
        .Send handler.scenario
        .WaitForResponse
        wr = .ResponseText
    End With

    Set json = JsonConverter.ParseJson(wr)
    'Set scenario_totals = json


End Sub