VBA/handler.bas

Attribute VB_Name = "handler"
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
Public basis() As Variant
Public baseline() As Variant
Public adjust() As Variant


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
       
    
    fpvt.Show
     


End Sub

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", handler.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



Function request_adjust(doc As String) As Object

    Dim req As New WinHttp.WinHttpRequest
    Dim json As Object
    Dim wr As String
    Dim i As Integer
    Dim j As Integer
    Dim str() As String
    
    Set json = JsonConverter.ParseJson(doc)
    
    With req
        .Open "POST", server & "/" & json("type"), True
        .SetRequestHeader "Content-Type", "application/json"
        .Send doc
        .WaitForResponse
        wr = .ResponseText
    End With
    
    If Mid(wr, 2, 5) = "error" Then
        MsgBox (wr)
        Exit Function
    End If
    
    If Mid(wr, 1, 6) = "<body>" Then
        MsgBox (wr)
        Exit Function
    End If

    Set json = JsonConverter.ParseJson(wr)
    
    If IsNull(json("x")) Then
        MsgBox ("no adjustment was made")
        Exit Function
    End If
    
    ReDim res(json("x").Count - 1, 32)
    
    For i = 1 To UBound(res, 1) + 1
        res(i - 1, 0) = json("x")(i)("bill_cust_descr")
        res(i - 1, 1) = json("x")(i)("billto_group")
        res(i - 1, 2) = json("x")(i)("ship_cust_descr")
        res(i - 1, 3) = json("x")(i)("shipto_group")
        res(i - 1, 4) = json("x")(i)("quota_rep_descr")
        res(i - 1, 5) = json("x")(i)("director_descr")
        res(i - 1, 6) = json("x")(i)("segm")
        res(i - 1, 7) = json("x")(i)("mod_chan")
        res(i - 1, 8) = json("x")(i)("mod_chansub")
        res(i - 1, 9) = json("x")(i)("majg_descr")
        res(i - 1, 10) = json("x")(i)("ming_descr")
        res(i - 1, 11) = json("x")(i)("majs_descr")
        res(i - 1, 12) = json("x")(i)("mins_descr")
        res(i - 1, 13) = json("x")(i)("brand")
        res(i - 1, 14) = json("x")(i)("part_family")
        res(i - 1, 15) = json("x")(i)("part_group")
        res(i - 1, 16) = json("x")(i)("branding")
        res(i - 1, 17) = json("x")(i)("color")
        res(i - 1, 18) = json("x")(i)("part_descr")
        res(i - 1, 19) = json("x")(i)("order_season")
        res(i - 1, 20) = json("x")(i)("order_month")
        res(i - 1, 21) = json("x")(i)("ship_season")
        res(i - 1, 22) = json("x")(i)("ship_month")
        res(i - 1, 23) = json("x")(i)("request_season")
        res(i - 1, 24) = json("x")(i)("request_month")
        res(i - 1, 25) = json("x")(i)("promo")
        res(i - 1, 26) = json("x")(i)("version")
        res(i - 1, 27) = json("x")(i)("iter")
        res(i - 1, 28) = json("x")(i)("value_loc")
        res(i - 1, 29) = json("x")(i)("value_usd")
        res(i - 1, 30) = json("x")(i)("cost_loc")
        res(i - 1, 31) = json("x")(i)("cost_usd")
        res(i - 1, 32) = json("x")(i)("units")
    Next i
    
    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
    
    Do Until Sheets("data").Cells(i, 1) = ""
        i = i + 1
    Loop
    
    
    Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32)
    
    Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
    
End Function

Sub load_config()

    Dim i As Integer
    Dim j As Integer
    '----server to use---------------------------------------------------------
    handler.server = Sheets("config").Cells(1, 2)
    '---basis-----------------------------------------------------------------
    ReDim handler.basis(100)
    i = 2
    j = 0
    Do While Sheets("config").Cells(2, i) <> ""
        handler.basis(j) = Sheets("config").Cells(2, i)
        j = j + 1
        i = i + 1
    Loop
    ReDim Preserve handler.basis(j - 1)
    '---baseline-----------------------------------------------------------------
    ReDim handler.baseline(100)
    i = 2
    j = 0
    Do While Sheets("config").Cells(3, i) <> ""
        handler.baseline(j) = Sheets("config").Cells(3, i)
        j = j + 1
        i = i + 1
    Loop
    ReDim Preserve handler.baseline(j - 1)
    '---adjustments-----------------------------------------------------------------
    ReDim handler.adjust(100)
    i = 2
    j = 0
    Do While Sheets("config").Cells(4, i) <> ""
        handler.adjust(j) = Sheets("config").Cells(4, i)
        j = j + 1
        i = i + 1
    Loop
    ReDim Preserve handler.adjust(j - 1)
    
End Sub