mastermacro/GetDataAllPlants.bas

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