corrected the all button so it properly populates all plants
This commit is contained in:
228
GetData.bas
Normal file
228
GetData.bas
Normal file
@@ -0,0 +1,228 @@
|
||||
Attribute VB_Name = "GetData"
|
||||
Sub getData()
|
||||
On Error GoTo ErrorHandler ' Enable error handling
|
||||
|
||||
Dim plantSelect As String
|
||||
Dim req As New WinHttpRequest
|
||||
Dim reqUrl As String
|
||||
Dim cell As Range
|
||||
Dim plantFound As Boolean
|
||||
Dim plantData As Range
|
||||
Dim queryData As Range
|
||||
Dim server As String
|
||||
Dim queryToRun As String
|
||||
Dim ws As Worksheet
|
||||
Dim lastColumn As Integer
|
||||
Dim dataRange As Variant
|
||||
Dim json As Object
|
||||
Dim dataArray As Object
|
||||
Dim headerRow As Range
|
||||
|
||||
|
||||
|
||||
'where is our plant data to match too?
|
||||
Set plantData = Sheet2.Range("A1:B30")
|
||||
Set queryData = Sheet2.Range("D2:E100")
|
||||
|
||||
' what plant is selected
|
||||
plantSelect = Sheets("Data").Range("E1").Value
|
||||
|
||||
'until the all function is created send a message box to check the server
|
||||
'If plantSelect = "All" Then
|
||||
' MsgBox "The ""All"" function is not fully operational please select a plant to move forward"
|
||||
' Exit Sub
|
||||
'End If
|
||||
|
||||
'if we are missing the query we want to warn everyone too
|
||||
If Sheets("Data").Range("G1").Value = "" Then
|
||||
MsgBox "Please select a query you want to pull before pressing the ""Get data"" button."
|
||||
End If
|
||||
|
||||
'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
|
||||
Sheets("Data").Range("A5:BB50000").ClearContents
|
||||
End If
|
||||
|
||||
On Error GoTo 0
|
||||
|
||||
'go back to the setup data sheet maybe :P
|
||||
Sheets("Data").Select
|
||||
' Sheets("Data").Range("A5:BB50000").ClearContents
|
||||
|
||||
' create the url from the plan
|
||||
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
|
||||
|
||||
|
||||
'get the query endpoint
|
||||
For Each cell In queryData
|
||||
If cell.Value = Sheets("Data").Range("G1").Value Then
|
||||
'Debug.Print "Server that was selected : " & cell.Offset(0, 1).Value
|
||||
queryToRun = cell.Offset(0, 1).Value
|
||||
Exit For
|
||||
End If
|
||||
Next cell
|
||||
|
||||
' if the query would have extra parameters add them here
|
||||
For Each cell In queryData
|
||||
If cell.Value = Sheets("Data").Range("G1").Value Then
|
||||
'Debug.Print "Server that was selected : " & cell.Offset(0, 1).Value
|
||||
'queryToRun = queryToRun + cell.Offset(0, 2).Value
|
||||
|
||||
'add the first part of the additional critiera to the query
|
||||
If Sheets("Data").Range("D2").Value <> "" Then
|
||||
If Trim(Sheets("Data").Range("D2").Value) <> "" And Trim(Sheets("Data").Range("D3").Value) <> "" Then
|
||||
queryToRun = queryToRun & "?" & Sheets("Data").Range("D2").Value & "=" & Sheets("Data").Range("D3").Value
|
||||
If Sheets("Data").Range("E2").Value <> "" And Sheets("Data").Range("E3").Value <> "" Then
|
||||
queryToRun = queryToRun & "&" & Sheets("Data").Range("E2").Value & "=" & Sheets("Data").Range("E3").Value
|
||||
If Sheets("Data").Range("F2").Value <> "" And Sheets("Data").Range("F3").Value <> "" Then
|
||||
queryToRun = queryToRun & "&" & Sheets("Data").Range("F2").Value & "=" & Sheets("Data").Range("F3").Value
|
||||
End If
|
||||
End If
|
||||
ElseIf Trim(Sheets("Data").Range("E2").Value) <> "" And Trim(Sheets("Data").Range("E3").Value) <> "" Then
|
||||
queryToRun = queryToRun & "?" & Sheets("Data").Range("E2").Value & "=" & Sheets("Data").Range("E3").Value
|
||||
End If
|
||||
End If
|
||||
Exit For
|
||||
End If
|
||||
Next cell
|
||||
|
||||
'Debug.Print queryToRun
|
||||
If plantSelect = "All" Then
|
||||
'reqUrl = "http://localhost:4000" & queryToRun
|
||||
getAllPlants queryToRun
|
||||
Exit Sub
|
||||
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" & queryToRun
|
||||
Else
|
||||
reqUrl = "http://" & server & ":3000" & queryToRun
|
||||
End If
|
||||
End If
|
||||
|
||||
Debug.Print reqUrl
|
||||
|
||||
'url is created get the request going.
|
||||
req.Open "GET", reqUrl, False
|
||||
|
||||
req.Send
|
||||
|
||||
If req.Status <> 200 Then
|
||||
MsgBox req.Status & " - " & req.StatusText & " - " & req.ResponseText
|
||||
Exit Sub
|
||||
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
|
||||
|
||||
Set json = JsonConverter.ParseJson(jsonResponse)
|
||||
|
||||
Set dataArray = json("data")
|
||||
|
||||
'Debug.Print dataArray
|
||||
|
||||
' Check if dataArray is empty
|
||||
If dataArray.Count = 0 Then
|
||||
MsgBox "There is no data 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
|
||||
|
||||
' 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
|
||||
'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(5, h).Value = Item ' Place the key as a header
|
||||
h = h + 1
|
||||
Next Item
|
||||
|
||||
|
||||
' Disable screen updating and calculations for faster execution
|
||||
Application.ScreenUpdating = False
|
||||
Application.Calculation = xlCalculationManual
|
||||
|
||||
' Debug.Print "Column count " & h
|
||||
' Populate data row by row
|
||||
Dim cellValue As Variant
|
||||
Dim rowIndex As Integer
|
||||
rowIndex = 6 ' Start from row 6
|
||||
|
||||
For j = 1 To dataArray.Count ' Iterate from the first element of dataArray
|
||||
For x = 1 To h
|
||||
'ws.Cells(rowIndex, x).Value = dataArray(j)(headerRow.Cells(5, x).Value)
|
||||
cellValue = dataArray(j)(headerRow.Cells(5, x).Value)
|
||||
|
||||
If VarType(cellValue) = vbString Then
|
||||
ws.Cells(rowIndex, x).Value = "'" & cellValue ' Prefixing with apostrophe forces Excel to treat it as text
|
||||
Else
|
||||
ws.Cells(rowIndex, x).Value = cellValue
|
||||
End If
|
||||
Next x
|
||||
rowIndex = rowIndex + 1 ' Move to the next row
|
||||
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
|
||||
Sheets("Data").Select
|
||||
MsgBox "Data processing successful!"
|
||||
Else
|
||||
MsgBox "Error: " & json("message")
|
||||
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
|
||||
ElseIf Err.Number = -2147012894 Then
|
||||
MsgBox "Server is not reachable please try again later."
|
||||
|
||||
' Handle other errors
|
||||
MsgBox "An unexpected error occurred: " & Err.Description, vbCritical
|
||||
End If
|
||||
|
||||
End Sub
|
||||
Reference in New Issue
Block a user