pt/forecast_api
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Batch error messages and identify period to which they apply.

Browse Source 
This happens on the Monthly view, and it's possible to get multiple
error messages, even among other successful month adjustments. There was
no way of knowing which month was the offending one or if any had
succeeded when an error was shown.

This change collects all the error messages into one message with the
period so that it's more intuitive and less obtrusive.
This commit is contained in:
PhilRunninger 2023-08-31 17:07:58 -04:00
parent 7bd8cc2674
commit 3fa2cb07f5
9 changed files with 29 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Master Template.xlsm
View File

Binary file not shown.

BIN
VBA/build.frx
View File

Binary file not shown.

BIN
VBA/changes.frx
View File

Binary file not shown.

5
VBA/fpvt.frm
View File

@ -59,9 +59,8 @@ Private Sub butAdjust_Click()
Exit Sub Exit Sub
End If End If
Call handler.request_adjust(tbAPI.text, fail) If Not handler.request_adjust(tbAPI.text, msg) Then
If fail Then MsgBox msg, vbOKOnly Or vbExclamation, "Adjustment was not made due to error."
MsgBox "Adjustment was not made due to error.", vbOKOnly Or vbExclamation
Exit Sub Exit Sub
End If End If

BIN
VBA/fpvt.frx
View File

Binary file not shown.

57
VBA/handler.bas
View File

@ -229,7 +229,7 @@ End Sub
Function request_adjust(doc As String, ByRef fail As Boolean) As Object Function request_adjust(doc As String, ByRef msg As String) As Boolean
Dim req As New WinHttp.WinHttpRequest Dim req As New WinHttp.WinHttpRequest
Dim json As Object Dim json As Object
@ -238,8 +238,10 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
Dim j As Long Dim j As Long
Dim str() As String Dim str() As String
request_adjust = False
If doc = "" Then If doc = "" Then
fail = True msg = "No data was given to be processed."
Exit Function Exit Function
End If End If
@ -263,35 +265,23 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
Debug.Print Timer - t; "sec): "; Left(wr, 200) Debug.Print Timer - t; "sec): "; Left(wr, 200)
End With End With
If Mid(wr, 2, 5) = "error" Then If Mid(wr, 2, 5) = "error" Or _
MsgBox (wr) Mid(wr, 1, 6) = "<body>" Or _
fail = True Mid(wr, 1, 6) = "<!DOCT" _
Exit Function Then
End If msg = wr
If Mid(wr, 1, 6) = "<body>" Then
MsgBox (wr)
fail = True
Exit Function
End If
If Mid(wr, 1, 6) = "<!DOCT" Then
MsgBox (wr)
fail = True
Exit Function Exit Function
End If End If
If Mid(wr, 1, 6) = "null" Then If Mid(wr, 1, 6) = "null" Then
MsgBox ("API route not implemented") msg = "API route not implemented"
fail = True
Exit Function Exit Function
End If End If
Set json = JsonConverter.ParseJson(wr) Set json = JsonConverter.ParseJson(wr)
If IsNull(json("x")) Then If IsNull(json("x")) Then
MsgBox ("No adjustment was made.") msg = "No adjustment was made."
fail = False
Exit Function Exit Function
End If End If
@ -335,30 +325,10 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
res(i, 34) = json("x")(i + 1)("pounds") res(i, 34) = json("x")(i + 1)("pounds")
Next i Next i
Set json = Nothing request_adjust = True
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
i = 1
Do Until shData.Cells(i, 1) = ""
i = i + 1
Loop
i = shData.UsedRange.Rows.Count + 1
Call Utils.SHTp_DumpVar(res, shData.Name, i, 1, False, False, True) Call Utils.SHTp_DumpVar(res, shData.Name, i, 1, False, False, True)
'Call Utils.SHTp_Dump(str, shData.Name, CLng(i), 1, False, False, 28, 29, 30, 31, 32)
shOrders.PivotTables("ptOrders").PivotCache.Refresh shOrders.PivotTables("ptOrders").PivotCache.Refresh
End Function End Function
@ -543,7 +513,6 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
Set json = JsonConverter.ParseJson(wr) Set json = JsonConverter.ParseJson(wr)
If IsNull(json("x")) Then If IsNull(json("x")) Then
MsgBox ("No history.")
fail = True fail = True
Exit Function Exit Function
End If End If

BIN
VBA/openf.frx
View File

Binary file not shown.

BIN
VBA/part.frx
View File

Binary file not shown.

17
VBA/shMonthView.cls
View File

@ -719,7 +719,6 @@ Sub post_adjust()
Exit Sub Exit Sub
End If End If
Dim fail As Boolean
Dim adjust As Object Dim adjust As Object
Dim jdoc As String Dim jdoc As String
@ -728,19 +727,27 @@ Sub post_adjust()
adjust("message") = shMonthView.Range("MonthComment").Value adjust("message") = shMonthView.Range("MonthComment").Value
adjust("tag") = shMonthView.Range("MonthTag").Value adjust("tag") = shMonthView.Range("MonthTag").Value
jdoc = JsonConverter.ConvertToJson(adjust) jdoc = JsonConverter.ConvertToJson(adjust)
Call handler.request_adjust(jdoc, fail) If Not handler.request_adjust(jdoc, msg) Then
If fail Then Exit Sub MsgBox msg, vbOKOnly Or vbCritical, "Adjustment was not made."
Exit Sub
End If
Else Else
Dim allMsg As String
For i = 2 To 13 For i = 2 To 13
If shMonthUpdate.Cells(i, 16) <> "" Then If shMonthUpdate.Cells(i, 16) <> "" Then
Set adjust = JsonConverter.ParseJson(shMonthUpdate.Cells(i, 16)) Set adjust = JsonConverter.ParseJson(shMonthUpdate.Cells(i, 16))
adjust("message") = shMonthView.Range("MonthComment").Value adjust("message") = shMonthView.Range("MonthComment").Value
adjust("tag") = shMonthView.Range("MonthTag").Value adjust("tag") = shMonthView.Range("MonthTag").Value
jdoc = JsonConverter.ConvertToJson(adjust) jdoc = JsonConverter.ConvertToJson(adjust)
Call handler.request_adjust(jdoc, fail) If Not handler.request_adjust(jdoc, msg) Then
If fail Then Exit Sub Dim period As String
period = Format(i - 1, "00") & " - " & Format(DateSerial(2000, (i - 1) + 5, 1), "mmm")
allMsg = IIf(allMsg = "", "", vbNewLine) & period & ": " & msg
End If
End If End If
Next i Next i
If allMsg <> "" Then MsgBox allMsg, vbOKOnly Or vbCritical, "Problems Loading Adjustments"
End If End If
shOrders.Select shOrders.Select