141 lines
4.1 KiB
QBasic
141 lines
4.1 KiB
QBasic
Attribute VB_Name = "GetAvalibleQuerys"
|
|
Sub queryAvi()
|
|
|
|
On Error GoTo ErrorHandler ' Enable error handling
|
|
|
|
Dim req As New WinHttpRequest
|
|
Dim reqUrl As String
|
|
Dim plantSelect As String
|
|
Dim staticData As Worksheet
|
|
Dim jsonResponse As String
|
|
Dim json As Object
|
|
Dim sheetVersion As Object
|
|
Dim server As String
|
|
|
|
|
|
'where is our plant data to match too?
|
|
Dim plantData As Range
|
|
Set plantData = Sheet2.Range("A1:B30")
|
|
|
|
' clear the data if any is there
|
|
'Sheet1.Range("A8:C8").Clear
|
|
|
|
'get the plant server based on the selection
|
|
plantSelect = Sheets("Data").Range("E1").Value
|
|
|
|
' Check if we have a match before moving forward
|
|
Dim cell As Range
|
|
Dim plantFound As Boolean
|
|
|
|
plantFound = False
|
|
|
|
For Each cell In plantData
|
|
If cell.Value = plantSelect Then
|
|
' Found the server
|
|
If cell.Value = "All" Then
|
|
'Debug.Print "all servers were selected"
|
|
Exit For
|
|
Else
|
|
'Debug.Print "Server that was selected : " & cell.Offset(0, 1).Value
|
|
server = cell.Offset(0, 1).Value
|
|
Exit For
|
|
End If
|
|
Exit For
|
|
End If
|
|
Next cell
|
|
|
|
'if all is selected it will point to the test server.
|
|
|
|
If plantSelect = "All" Then
|
|
reqUrl = "http://usmcd1vms036:3000/api/datamart/getavalibleaquerys"
|
|
Else
|
|
' as iowa pet is on a differnt port we want to grab keep everything the same
|
|
If plantSelect = "Iowa ISBM, Iowa" Then
|
|
|
|
reqUrl = "http://" & server & ":3001/api/datamart/getavalibleaquerys"
|
|
Else
|
|
reqUrl = "http://" & server & ":3000/api/datamart/getavalibleaquerys"
|
|
End If
|
|
End If
|
|
|
|
'double checking the url
|
|
Debug.Print "Url to pull the querys form it " & reqUrl
|
|
|
|
'set the static data sheet
|
|
Set staticData = Sheet2
|
|
|
|
'clear the content so its always fresh
|
|
staticData.Range("D1:E20").ClearContents
|
|
|
|
' get the data
|
|
req.Open "GET", reqUrl, False
|
|
|
|
req.Send
|
|
|
|
If req.Status <> 200 Then
|
|
MsgBox req.Status & " - " & req.StatusText
|
|
End If
|
|
|
|
|
|
' Get the response text (JSON)
|
|
jsonResponse = req.ResponseText
|
|
|
|
' crtl + g to pull up the debut
|
|
|
|
' Debug print the raw JSON response
|
|
' Debug.Print jsonResponse
|
|
|
|
' Parse the JSON response using JsonConverter
|
|
Set json = JsonConverter.ParseJson(jsonResponse)
|
|
|
|
|
|
'Debug.Print json("sheetVersion")
|
|
|
|
Set dataArray = json("data")
|
|
|
|
' Set up the headers in the first row just for a reference
|
|
Set headerRow = Sheet2.Range("D1")
|
|
|
|
|
|
' Dump the querys into the table so we can use it in our list :)
|
|
If json("success") Then
|
|
'add the headers
|
|
' Loop through the first item to get the keys (name, endpoint)
|
|
h = 1
|
|
For Each Item In dataArray(1).Keys
|
|
' Debug.Print Item
|
|
headerRow.Cells(1, h).Value = Item ' Place the key as a header
|
|
h = h + 1
|
|
Next Item
|
|
|
|
' Populate the data below the headers
|
|
For j = 1 To dataArray.Count
|
|
i = 1
|
|
For Each Item In dataArray(j).Keys
|
|
headerRow.Offset(j, i - 1).Value = dataArray(j)(Item) ' Populate data under the headers
|
|
i = i + 1
|
|
Next Item
|
|
Next j
|
|
Else
|
|
MsgBox "Error: " & json("message")
|
|
End If
|
|
|
|
If json("sheetVersion") <> Sheet2.Range("I1").Value Then
|
|
MsgBox "There is a new version of the sheet please download the new version to get all the fixes, you do not need to but errors will not be supported on older versions! You can get a new sheet from NOAM logistics > plant mgt files"
|
|
Exit Sub
|
|
End If
|
|
|
|
Exit Sub
|
|
|
|
ErrorHandler:
|
|
' Handle specific error for connection issues
|
|
If Err.Number = -2147012867 Then
|
|
MsgBox "Please make sure you are connected to vpn, and or make sure the server is online.", vbCritical
|
|
Else
|
|
' Handle other errors
|
|
MsgBox "An unexpected error occurred: " & Err.Description, vbCritical
|
|
End If
|
|
|
|
End Sub
|
|
|