corrected the all button so it properly populates all plants
This commit is contained in:
170
GetDataAllPlants.bas
Normal file
170
GetDataAllPlants.bas
Normal file
@@ -0,0 +1,170 @@
|
||||
Attribute VB_Name = "GetDataAllPlants"
|
||||
Sub getAllPlants(ByVal query As String)
|
||||
|
||||
Dim req As New WinHttpRequest
|
||||
|
||||
Dim json As Object
|
||||
Dim dataArray As Object
|
||||
Dim headerRow As Range
|
||||
|
||||
Dim plantData As Range
|
||||
Dim reqUrl As String
|
||||
Dim firstRound As Boolean
|
||||
Dim lastRow As Long
|
||||
|
||||
'where is our plant data to match too?
|
||||
Set plantData = Sheet2.Range("A2:A30")
|
||||
|
||||
Debug.Print "All plants running and the endpoint that will be hit: " & query
|
||||
|
||||
'check if the data sheet was removed or changed and recreate it it was changed and then clear the data
|
||||
On Error Resume Next
|
||||
Set ws = Sheets("Data")
|
||||
If ws Is Nothing Then
|
||||
Set ws = Sheets.Add
|
||||
ws.Name = "Data"
|
||||
Else
|
||||
'ws.Cells.Clear ' Clear existing data if the sheet already exists
|
||||
End If
|
||||
On Error GoTo 0
|
||||
|
||||
firstRound = False
|
||||
|
||||
For Each cell In plantData
|
||||
'Debug.Print "Server that was selected : " & cell.Offset(0, 1).Value
|
||||
|
||||
If cell.Value <> "" Then
|
||||
' we dont want to try and get localhost
|
||||
If cell.Value = "Dev Server" Then
|
||||
GoTo SkipIteration
|
||||
End If
|
||||
' skip the test server too
|
||||
If cell.Value = "TestServer" Then
|
||||
GoTo SkipIteration
|
||||
End If
|
||||
|
||||
' as iowa pet is on a differnt port we want to grab keep everything the same
|
||||
If cell.Value = "Iowa ISBM, Iowa" Then
|
||||
|
||||
reqUrl = "http://" & cell.Offset(0, 1).Value & ":3001" & query
|
||||
Else
|
||||
reqUrl = "http://" & cell.Offset(0, 1).Value & ":3000" & query
|
||||
End If
|
||||
|
||||
Debug.Print reqUrl
|
||||
|
||||
On Error Resume Next ' Ignore errors and continue execution
|
||||
|
||||
'url is created get the request going.
|
||||
req.Open "GET", reqUrl, False
|
||||
|
||||
req.Send
|
||||
|
||||
If Err.Number <> 0 Then
|
||||
Debug.Print "An error occurred: " & Err.Description
|
||||
Else
|
||||
'Debug.Print req.StatusText
|
||||
|
||||
|
||||
|
||||
On Error GoTo 0 ' Reset error handling to default
|
||||
|
||||
If req.Status <> 200 Then
|
||||
Debug.Print req.Status & " - " & req.StatusText
|
||||
Else
|
||||
|
||||
|
||||
' Get the response text (JSON)
|
||||
jsonResponse = req.ResponseText
|
||||
|
||||
Set json = JsonConverter.ParseJson(jsonResponse)
|
||||
|
||||
Set dataArray = json("data")
|
||||
'how many we got
|
||||
Debug.Print dataArray.Count
|
||||
|
||||
' Check if dataArray is empty
|
||||
If dataArray.Count = 0 Then
|
||||
'MsgBox "There is no data for " & cell.Value & ", if you this is an error please try again, if repeats please constact support.", vbExclamation, "No Data"
|
||||
|
||||
'Exit Sub 'just stop doing anything else
|
||||
End If
|
||||
|
||||
|
||||
'if we have over 15k lines just exit and direct the user to get the data from lst
|
||||
If dataArray.Count > 15000 Then
|
||||
MsgBox "There is more than 15,000 lines of data please, export the data from LST\n for perforance reasons no data will be loaded", vbExclamation, "No Data"
|
||||
|
||||
'Exit Sub 'just stop doing anything else
|
||||
End If
|
||||
|
||||
'for the first plant we want to add the headers and then not do it again.
|
||||
|
||||
' Set up the headers in the first row just for a reference
|
||||
Set headerRow = Sheets("Data").Range("A1")
|
||||
|
||||
' Dump the querys into the table so we can use it in our list :)
|
||||
If json("success") Then
|
||||
'Debug.Print "First plant"
|
||||
If Not firstRound Then
|
||||
'add the headers
|
||||
Debug.Print "Running as first plant"
|
||||
Sheets("Data").Range("A5:BB50000").ClearContents
|
||||
' 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(5, h).Value = Item ' Place the key as a header
|
||||
h = h + 1
|
||||
Next Item
|
||||
firstRound = True
|
||||
End If
|
||||
|
||||
|
||||
|
||||
'add the rows in.
|
||||
|
||||
' Disable screen updating and calculations for faster execution
|
||||
Application.ScreenUpdating = False
|
||||
Application.Calculation = xlCalculationManual
|
||||
|
||||
' Debug.Print "Column count " & h
|
||||
' Populate data row by row
|
||||
'For j = 1 To dataArray.Count
|
||||
' For x = 1 To h
|
||||
' 'Debug.Print dataArray(j)(headerRow.Cells(1, i).Value)
|
||||
' ws.Cells(j + 1, x).Value = dataArray(j)(headerRow.Cells(1, x).Value)
|
||||
' Next x
|
||||
'Next j
|
||||
|
||||
'Dim lastRow As Long
|
||||
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
|
||||
lastRow = Application.Max(4, lastRow)
|
||||
|
||||
' Populate data row by row, starting from the lastRow + 1
|
||||
For j = 1 To dataArray.Count
|
||||
For x = 1 To h
|
||||
ws.Cells(lastRow + j, x).Value = dataArray(j)(headerRow.Cells(5, x).Value)
|
||||
Next x
|
||||
Next j
|
||||
|
||||
' Re-enable screen updating and calculations
|
||||
Application.ScreenUpdating = True
|
||||
Application.Calculation = xlCalculationAutomatic
|
||||
|
||||
' Determine the last column used based on the number of headers
|
||||
lastColumn = h
|
||||
|
||||
' Automatically adjust the width of all used columns
|
||||
ws.Columns(1).Resize(, lastColumn).AutoFit ' Adjust based on last column
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
SkipIteration: ' Label to jump to the next iteration
|
||||
|
||||
|
||||
Next cell
|
||||
MsgBox "Data processing successful!"
|
||||
End Sub
|
||||
Reference in New Issue
Block a user