error handling for request

This commit is contained in:
Trowbridge 2019-03-21 02:58:47 -04:00
parent f6207d0586
commit 70326aa1fb
2 changed files with 28 additions and 11 deletions

View File

@ -198,7 +198,7 @@ End Sub
Function request_adjust(doc As String) As Object Function request_adjust(doc As String, ByRef fail As Boolean) As Object
Dim req As New WinHttp.WinHttpRequest Dim req As New WinHttp.WinHttpRequest
Dim json As Object Dim json As Object
@ -221,11 +221,19 @@ Function request_adjust(doc As String) As Object
If Mid(wr, 2, 5) = "error" Then If Mid(wr, 2, 5) = "error" Then
MsgBox (wr) MsgBox (wr)
fail = True
Exit Function Exit Function
End If End If
If Mid(wr, 1, 6) = "<body>" Then If Mid(wr, 1, 6) = "<body>" Then
MsgBox (wr) 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
@ -233,6 +241,7 @@ Function request_adjust(doc As String) As Object
If IsNull(json("x")) Then If IsNull(json("x")) Then
MsgBox ("no adjustment was made") MsgBox ("no adjustment was made")
fail = True
Exit Function Exit Function
End If End If

View File

@ -58,11 +58,11 @@ Private Sub Worksheet_Change(ByVal target As Range)
End If End If
End Sub End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean) Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean)
If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
Cancel = True cancel = True
Call Me.basket_pick(target) Call Me.basket_pick(target)
target.Select target.Select
End If End If
@ -79,10 +79,10 @@ Attribute picker_shortcut.VB_ProcData.VB_Invoke_Func = "I\n14"
End Sub End Sub
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean) Private Sub Worksheet_BeforeRightClick(ByVal target As Range, cancel As Boolean)
If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
Cancel = True cancel = True
Call Me.basket_pick(target) Call Me.basket_pick(target)
target.Select target.Select
End If End If
@ -488,6 +488,7 @@ Sub build_json()
np("scenario")("version") = "b20" np("scenario")("version") = "b20"
np("scenario")("iter") = handler.basis np("scenario")("iter") = handler.basis
np("source") = "adj" np("source") = "adj"
np("type") = "new_part"
Set m = JsonConverter.ParseJson("{}") Set m = JsonConverter.ParseJson("{}")
End If End If
@ -596,7 +597,7 @@ Sub crunch_array()
End Sub End Sub
Sub Cancel() Sub cancel()
Sheets("Orders").Select Sheets("Orders").Select
@ -764,12 +765,19 @@ End Sub
Sub post_adjust() Sub post_adjust()
Dim i As Long Dim i As Long
Dim fail As Boolean
If Me.newpart Then
Call handler.request_adjust(Sheets("_month").Cells(2, 16), fail)
If fail Then Exit Sub
Else
For i = 2 To 13 For i = 2 To 13
If Sheets("_month").Cells(i, 16) <> "" Then If Sheets("_month").Cells(i, 16) <> "" Then
Call handler.request_adjust(Sheets("_month").Cells(i, 16)) Call handler.request_adjust(Sheets("_month").Cells(i, 16), fail)
If fail Then Exit Sub
End If End If
Next i Next i
End If
Sheets("Orders").Select Sheets("Orders").Select
Worksheets("month").Visible = xlHidden Worksheets("month").Visible = xlHidden