Import Deals into Excel with VBA | Hi Energy AI Macros

Deals → Excel overview

Use Excel VBA WinHttp and your Hi Energy AI API key to import active affiliate deals into Excel. This guide includes paste-ready code for pagination, JSON:API flattening, and writing rows to a Deals worksheet.

Endpoint: GET /api/v1/deals

Deals API reference Get API key Excel overview

List responses nest records under deals.data (JSON:API). The sample flattens id, type, and attributes into spreadsheet columns.

Setup in Excel (VBA macros)

Open Excel on Windows (or Excel for Mac with VBA support) and enable the Developer tab: File → Options → Customize Ribbon → Developer.
Get your personal API key from API key docs. Prefer the X-Api-Key header (these samples already do).
Create a worksheet named Config with HIENERGY_API_KEY in A1 and your key value in B1. Optionally set HIENERGY_API_BASE in A2 / B2.
Press Alt+F11 → Insert → Module. Paste the shared client library, then add a second module for the resource import macro below.
In the VBA editor choose Tools → References and enable Microsoft Scripting Runtime.
Save as a macro-enabled workbook (.xlsm), then run the import with Alt+F8 (or Developer → Macros).

1. Shared VBA client

Paste this helper library into one standard module once. Every Hi Energy Excel importer on this site reuses the same WinHttp client, JSON parser, JSON:API flattener, and sheet writer.

Option Explicit

' Hi Energy AI — shared Excel VBA client (+ JSON helpers)
' Paste into ONE standard module named HiEnergyClient.
'
' Setup:
' 1. Enable the Developer tab (File → Options → Customize Ribbon → Developer)
' 2. Alt+F11 → Insert → Module → paste this file
' 3. Tools → References → check "Microsoft Scripting Runtime"
' 4. Create a worksheet named Config with:
'      A1 = HIENERGY_API_KEY
'      B1 = your personal API key (https://app.hienergy.ai/api_documentation/api_key)
'    Optional:
'      A2 = HIENERGY_API_BASE
'      B2 = custom host (defaults to https://app.hienergy.ai)
' 5. Paste a resource importer module, then run via Alt+F8
'
' Trust note: enable macros only for workbooks you created. Do not commit API keys to shared files.

Public Const HIENERGY_API_BASE_DEFAULT As String = "https://app.hienergy.ai"

Public Function GetHiEnergyApiKey() As String
  Dim key As String
  key = Trim$(CStr(NzConfig("HIENERGY_API_KEY")))
  If Len(key) = 0 Then
    Err.Raise vbObjectError + 1001, "HiEnergyClient", _
      "Missing Config API key. Put HIENERGY_API_KEY in Config!A1 and your key in Config!B1."
  End If
  GetHiEnergyApiKey = key
End Function

Public Function GetHiEnergyApiBase() As String
  Dim base As String
  base = Trim$(CStr(NzConfig("HIENERGY_API_BASE")))
  If Len(base) = 0 Then base = HIENERGY_API_BASE_DEFAULT
  If Right$(base, 1) = "/" Then base = Left$(base, Len(base) - 1)
  GetHiEnergyApiBase = base
End Function

Private Function NzConfig(ByVal keyName As String) As Variant
  Dim ws As Worksheet
  Dim lastRow As Long
  Dim r As Long
  On Error Resume Next
  Set ws = ThisWorkbook.Worksheets("Config")
  On Error GoTo 0
  If ws Is Nothing Then
    NzConfig = ""
    Exit Function
  End If
  lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
  For r = 1 To Application.Max(1, lastRow)
    If StrComp(Trim$(CStr(ws.Cells(r, 1).Value)), keyName, vbTextCompare) = 0 Then
      NzConfig = ws.Cells(r, 2).Value
      Exit Function
    End If
  Next r
  NzConfig = ""
End Function

Public Function NewQuery() As Object
  Set NewQuery = CreateObject("Scripting.Dictionary")
End Function

Public Function HiEnergyApiGet(ByVal path As String, Optional ByVal query As Object = Nothing) As Object
  Dim url As String
  Dim http As Object
  Dim body As String
  Dim status As Long
  Dim parsed As Object
  Dim message As String

  url = GetHiEnergyApiBase() & path
  If Not query Is Nothing Then url = url & BuildQueryString(query)

  Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
  http.Open "GET", url, False
  http.SetRequestHeader "X-Api-Key", GetHiEnergyApiKey()
  http.SetRequestHeader "Accept", "application/json"
  http.Send

  status = CLng(http.Status)
  body = CStr(http.ResponseText)
  Set parsed = ParseJson(body)

  If status < 200 Or status >= 300 Then
    message = body
    If Not parsed Is Nothing Then
      If parsed.Exists("error") Then message = CStr(parsed("error"))
      If parsed.Exists("message") Then message = CStr(parsed("message"))
    End If
    Err.Raise vbObjectError + 1002, "HiEnergyClient", "Hi Energy AI API HTTP " & status & ": " & message
  End If

  Set HiEnergyApiGet = parsed
End Function

Private Function BuildQueryString(ByVal query As Object) As String
  Dim key As Variant
  Dim first As Boolean
  Dim out As String
  Dim value As String
  first = True
  out = ""
  For Each key In query.Keys
    value = Trim$(CStr(query(key)))
    If Len(value) > 0 Then
      If first Then
        out = "?"
        first = False
      Else
        out = out & "&"
      End If
      out = out & UrlEncode(CStr(key)) & "=" & UrlEncode(value)
    End If
  Next key
  BuildQueryString = out
End Function

Private Function UrlEncode(ByVal value As String) As String
  Dim i As Long
  Dim ch As String
  Dim code As Integer
  Dim out As String
  For i = 1 To Len(value)
    ch = Mid$(value, i, 1)
    code = Asc(ch)
    Select Case code
      Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95, 126
        out = out & ch
      Case 32
        out = out & "%20"
      Case Else
        out = out & "%" & Right$("0" & Hex$(code), 2)
    End Select
  Next i
  UrlEncode = out
End Function

Public Function FlattenJsonApiItem(ByVal item As Object) As Object
  Dim row As Object
  Dim attrs As Object
  Dim key As Variant
  Set row = CreateObject("Scripting.Dictionary")
  If item Is Nothing Then
    Set FlattenJsonApiItem = row
    Exit Function
  End If
  If item.Exists("id") Then row("id") = Scalarize(item("id"))
  If item.Exists("type") Then row("type") = Scalarize(item("type"))
  If item.Exists("attributes") Then
    If TypeName(item("attributes")) = "Dictionary" Then
      Set attrs = item("attributes")
      For Each key In attrs.Keys
        row(CStr(key)) = Scalarize(attrs(key))
      Next key
    End If
  End If
  Set FlattenJsonApiItem = row
End Function

Public Function FlattenFlatItem(ByVal item As Object) As Object
  Dim row As Object
  Dim key As Variant
  Set row = CreateObject("Scripting.Dictionary")
  If item Is Nothing Then
    Set FlattenFlatItem = row
    Exit Function
  End If
  For Each key In item.Keys
    row(CStr(key)) = Scalarize(item(key))
  Next key
  Set FlattenFlatItem = row
End Function

Private Function Scalarize(ByVal value As Variant) As Variant
  If IsObject(value) Then
    Scalarize = JsonStringify(value)
  ElseIf IsNull(value) Or IsEmpty(value) Then
    Scalarize = ""
  Else
    Scalarize = value
  End If
End Function

Public Function ExtractJsonApiCollection(ByVal payload As Object, ParamArray preferredKeys() As Variant) As Collection
  Dim i As Long
  Dim key As String
  Dim node As Object
  Dim emptyCol As Collection
  Set emptyCol = New Collection
  If payload Is Nothing Then
    Set ExtractJsonApiCollection = emptyCol
    Exit Function
  End If

  If UBound(preferredKeys) >= LBound(preferredKeys) Then
    For i = LBound(preferredKeys) To UBound(preferredKeys)
      key = CStr(preferredKeys(i))
      If payload.Exists(key) Then
        If TypeName(payload(key)) = "Collection" Then
          Set ExtractJsonApiCollection = payload(key)
          Exit Function
        End If
        If TypeName(payload(key)) = "Dictionary" Then
          Set node = payload(key)
          If node.Exists("data") Then
            If TypeName(node("data")) = "Collection" Then
              Set ExtractJsonApiCollection = node("data")
              Exit Function
            End If
          End If
        End If
      End If
    Next i
  End If

  If payload.Exists("data") Then
    If TypeName(payload("data")) = "Collection" Then
      Set ExtractJsonApiCollection = payload("data")
      Exit Function
    End If
  End If

  Set ExtractJsonApiCollection = emptyCol
End Function

Public Function WriteObjectsToSheet(ByVal sheetName As String, ByVal rows As Collection, Optional ByVal clearSheet As Boolean = True) As Long
  Dim ws As Worksheet
  Dim headers As Collection
  Dim seen As Object
  Dim rowDict As Object
  Dim key As Variant
  Dim r As Long
  Dim c As Long

  On Error Resume Next
  Set ws = ThisWorkbook.Worksheets(sheetName)
  On Error GoTo 0
  If ws Is Nothing Then
    Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    On Error Resume Next
    ws.Name = sheetName
    On Error GoTo 0
  End If

  If clearSheet Then ws.Cells.ClearContents

  If rows Is Nothing Or rows.Count = 0 Then
    ws.Range("A1").Value = "No rows returned"
    WriteObjectsToSheet = 0
    Exit Function
  End If

  Set headers = New Collection
  Set seen = CreateObject("Scripting.Dictionary")
  For Each rowDict In rows
    For Each key In rowDict.Keys
      If Not seen.Exists(CStr(key)) Then
        headers.Add CStr(key)
        seen(CStr(key)) = True
      End If
    Next key
  Next rowDict

  For c = 1 To headers.Count
    ws.Cells(1, c).Value = headers(c)
  Next c

  r = 2
  For Each rowDict In rows
    For c = 1 To headers.Count
      If rowDict.Exists(headers(c)) Then
        ws.Cells(r, c).Value = rowDict(headers(c))
      End If
    Next c
    r = r + 1
  Next rowDict

  ws.Rows(1).Font.Bold = True
  WriteObjectsToSheet = rows.Count
End Function

Public Function IsoDateDaysAgo(ByVal days As Long) As String
  IsoDateDaysAgo = Format$(Date - days, "yyyy-mm-dd")
End Function

Public Function IsoDateToday() As String
  IsoDateToday = Format$(Date, "yyyy-mm-dd")
End Function

Public Function JsonStringify(ByVal value As Variant) As String
  Dim key As Variant
  Dim i As Long
  Dim parts() As String
  Dim n As Long
  Dim item As Variant

  If IsObject(value) Then
    If TypeName(value) = "Dictionary" Then
      n = 0
      If value.Count = 0 Then
        JsonStringify = "{}"
        Exit Function
      End If
      ReDim parts(0 To value.Count - 1)
      For Each key In value.Keys
        parts(n) = JsonEscape(CStr(key)) & ":" & JsonStringify(value(key))
        n = n + 1
      Next key
      JsonStringify = "{" & Join(parts, ",") & "}"
      Exit Function
    End If
    If TypeName(value) = "Collection" Then
      If value.Count = 0 Then
        JsonStringify = "[]"
        Exit Function
      End If
      ReDim parts(1 To value.Count)
      i = 1
      For Each item In value
        parts(i) = JsonStringify(item)
        i = i + 1
      Next item
      JsonStringify = "[" & Join(parts, ",") & "]"
      Exit Function
    End If
  End If

  If IsNull(value) Or IsEmpty(value) Then
    JsonStringify = "null"
  ElseIf VarType(value) = vbBoolean Then
    JsonStringify = IIf(value, "true", "false")
  ElseIf IsNumeric(value) And VarType(value) <> vbString Then
    JsonStringify = Replace$(CStr(value), ",", ".")
  Else
    JsonStringify = JsonEscape(CStr(value))
  End If
End Function

Private Function JsonEscape(ByVal value As String) As String
  value = Replace$(value, "\", "\\")
  value = Replace$(value, """", "\""")
  value = Replace$(value, vbCr, "\r")
  value = Replace$(value, vbLf, "\n")
  value = Replace$(value, vbTab, "\t")
  JsonEscape = """" & value & """"
End Function

Public Function ParseJson(ByVal jsonText As String) As Object
  Dim p As Long
  p = 1
  Set ParseJson = ParseJsonValue(jsonText, p)
End Function

Private Function ParseJsonValue(ByRef text As String, ByRef p As Long) As Variant
  SkipWs text, p
  Select Case Mid$(text, p, 1)
    Case "{"
      Set ParseJsonValue = ParseJsonObject(text, p)
    Case "["
      Set ParseJsonValue = ParseJsonArray(text, p)
    Case """"
      ParseJsonValue = ParseJsonString(text, p)
    Case "t"
      If Mid$(text, p, 4) <> "true" Then Err.Raise vbObjectError + 1100, , "Invalid JSON boolean"
      p = p + 4
      ParseJsonValue = True
    Case "f"
      If Mid$(text, p, 5) <> "false" Then Err.Raise vbObjectError + 1100, , "Invalid JSON boolean"
      p = p + 5
      ParseJsonValue = False
    Case "n"
      If Mid$(text, p, 4) <> "null" Then Err.Raise vbObjectError + 1100, , "Invalid JSON null"
      p = p + 4
      ParseJsonValue = Null
    Case Else
      ParseJsonValue = ParseJsonNumber(text, p)
  End Select
End Function

Private Function ParseJsonObject(ByRef text As String, ByRef p As Long) As Object
  Dim dict As Object
  Dim key As String
  Dim value As Variant
  Set dict = CreateObject("Scripting.Dictionary")
  p = p + 1
  SkipWs text, p
  If Mid$(text, p, 1) = "}" Then
    p = p + 1
    Set ParseJsonObject = dict
    Exit Function
  End If
  Do
    SkipWs text, p
    key = ParseJsonString(text, p)
    SkipWs text, p
    If Mid$(text, p, 1) <> ":" Then Err.Raise vbObjectError + 1101, , "Expected :"
    p = p + 1
    value = ParseJsonValue(text, p)
    If IsObject(value) Then
      Set dict(key) = value
    Else
      dict(key) = value
    End If
    SkipWs text, p
    If Mid$(text, p, 1) = "," Then
      p = p + 1
    Else
      Exit Do
    End If
  Loop
  SkipWs text, p
  If Mid$(text, p, 1) <> "}" Then Err.Raise vbObjectError + 1102, , "Expected }"
  p = p + 1
  Set ParseJsonObject = dict
End Function

Private Function ParseJsonArray(ByRef text As String, ByRef p As Long) As Collection
  Dim col As Collection
  Dim value As Variant
  Set col = New Collection
  p = p + 1
  SkipWs text, p
  If Mid$(text, p, 1) = "]" Then
    p = p + 1
    Set ParseJsonArray = col
    Exit Function
  End If
  Do
    value = ParseJsonValue(text, p)
    If IsObject(value) Then
      col.Add value
    Else
      col.Add value
    End If
    SkipWs text, p
    If Mid$(text, p, 1) = "," Then
      p = p + 1
    Else
      Exit Do
    End If
  Loop
  SkipWs text, p
  If Mid$(text, p, 1) <> "]" Then Err.Raise vbObjectError + 1103, , "Expected ]"
  p = p + 1
  Set ParseJsonArray = col
End Function

Private Function ParseJsonString(ByRef text As String, ByRef p As Long) As String
  Dim out As String
  Dim ch As String
  If Mid$(text, p, 1) <> """" Then Err.Raise vbObjectError + 1104, , "Expected string"
  p = p + 1
  Do While p <= Len(text)
    ch = Mid$(text, p, 1)
    p = p + 1
    If ch = """" Then
      ParseJsonString = out
      Exit Function
    End If
    If ch = "\" Then
      ch = Mid$(text, p, 1)
      p = p + 1
      Select Case ch
        Case """", "\", "/"
          out = out & ch
        Case "b"
          out = out & vbBack
        Case "f"
          out = out & vbFormFeed
        Case "n"
          out = out & vbLf
        Case "r"
          out = out & vbCr
        Case "t"
          out = out & vbTab
        Case "u"
          out = out & ChrW$("&H" & Mid$(text, p, 4))
          p = p + 4
        Case Else
          out = out & ch
      End Select
    Else
      out = out & ch
    End If
  Loop
  Err.Raise vbObjectError + 1105, , "Unterminated string"
End Function

Private Function ParseJsonNumber(ByRef text As String, ByRef p As Long) As Variant
  Dim startPos As Long
  Dim ch As String
  Dim raw As String
  startPos = p
  ch = Mid$(text, p, 1)
  If ch = "-" Then p = p + 1
  Do While p <= Len(text)
    ch = Mid$(text, p, 1)
    If (ch >= "0" And ch <= "9") Or ch = "." Or ch = "e" Or ch = "E" Or ch = "+" Or ch = "-" Then
      p = p + 1
    Else
      Exit Do
    End If
  Loop
  raw = Mid$(text, startPos, p - startPos)
  If InStr(raw, ".") > 0 Or InStr(1, raw, "e", vbTextCompare) > 0 Then
    ParseJsonNumber = CDbl(Val(raw))
  Else
    ParseJsonNumber = CLng(Val(raw))
  End If
End Function

Private Sub SkipWs(ByRef text As String, ByRef p As Long)
  Do While p <= Len(text)
    Select Case Mid$(text, p, 1)
      Case " ", vbTab, vbCr, vbLf
        p = p + 1
      Case Else
        Exit Do
    End Select
  Loop
End Sub

2. Deals import macro

Paste this into a second standard module, save as .xlsm, then run the import with Alt+F8.

Option Explicit

' Import affiliate deals into the active workbook.
' Requires the shared HiEnergyClient module in this VBA project.
' Run: Alt+F8 → ImportHiEnergyDeals

Public Sub ImportHiEnergyDeals()
  Dim page As Long
  Dim perPage As Long
  Dim maxPages As Long
  Dim allRows As Collection
  Dim query As Object
  Dim payload As Object
  Dim records As Collection
  Dim item As Object
  Dim count As Long

  page = 1
  perPage = 100
  maxPages = 20
  Set allRows = New Collection

  Do While page <= maxPages
    Set query = NewQuery()
    query("page") = page
    query("per_page") = perPage
    query("active") = "true"
    query("include_total") = "false"

    Set payload = HiEnergyApiGet("/api/v1/deals", query)
    Set records = ExtractJsonApiCollection(payload, "deals", "data")
    If records.Count = 0 Then Exit Do

    For Each item In records
      allRows.Add FlattenJsonApiItem(item)
    Next item

    If records.Count < perPage Then Exit Do
    page = page + 1
  Loop

  count = WriteObjectsToSheet("Deals", allRows, True)
  MsgBox "Imported " & count & " deals", vbInformation, "Hi Energy AI"
End Sub

Useful query parameters

Parameter	Purpose
`active`	Set true to keep only currently active deals.
`exclusive`	Filter exclusive offers when supported for your account.
`advertiser_id`	Limit deals to one advertiser / program.
`country`	Country or country_code filter for geo-targeted deals.
`deal_type`	Filter by deal kind / type labels from the deals API.
`page / per_page`	Offset pagination. The sample walks pages until a short page is returned.
`q / search`	Free-text search across deal content when needed.

FAQ

Paste the shared VBA client and deals importer from this page, store HIENERGY_API_KEY on a Config sheet, then run ImportHiEnergyDeals. The macro calls GET /api/v1/deals with X-Api-Key and writes flattened rows to a Deals worksheet.

For Hi Energy AI authentication use your personal API key via X-Api-Key. Excel only requires macros enabled and Microsoft Scripting Runtime referenced in the VBA project.

Nested objects and arrays from JSON:API attributes are stringified so every value fits in a single spreadsheet cell. Expand them with VBA or Power Query if you need columnar nested data.

Yes. Edit the sample query parameters such as active, exclusive, advertiser_id, country, deal_type, and search before running ImportHiEnergyDeals. Pagination walks pages until a short page is returned.

Yes. The Excel importer uses the live GET /api/v1/deals endpoint documented on the Deals API page, scoped to your account permissions and rate limits.

Yes. This page publishes TechArticle, HowTo, FAQPage, BreadcrumbList, WebSite SearchAction, and related endpoint ItemList structured data so answer engines can cite a concrete VBA import path.

Deals → Excel

Deals → Excel overview

Setup in Excel (VBA macros)

1. Shared VBA client

2. Deals import macro

Useful query parameters

FAQ

How do I import Hi Energy deals into Excel?

Do I need OAuth for Excel VBA?

Why are some deal fields JSON strings in the sheet?

Can I filter deals before they land in the sheet?

Is this the same data as the Deals API documentation?

Can AI agents cite this Excel deals workflow?

If this page feels TLDR, ask Dex AI.