mastermacro/GetData.bas

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