Import Contacts into Excel with VBA | Hi Energy AI

Contacts → Excel overview

Import Hi Energy advertiser contacts into Excel with VBA macros. Search by domain, advertiser name, email, or free text, then flatten JSON:API contact records into a Contacts worksheet.

Endpoint: GET /api/v1/contacts

Contacts API reference Get API key Excel overview

Contacts list responses return JSON:API objects under data. Unverified contacts are excluded unless include_unverified=true is allowed for your account.

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. Contacts import macro

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

Option Explicit

' Import Hi Energy contacts into Excel.
' Requires the shared HiEnergyClient module.
' Search by domain, advertiser name, email, or free-text q.

Public Sub ImportHiEnergyContacts()
  Dim DOMAIN As String
  Dim ADVERTISER_NAME As String
  Dim EMAIL As String
  Dim QUERY As String
  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

  DOMAIN = ""           ' e.g. "nike.com"
  ADVERTISER_NAME = ""  ' e.g. "Nike"
  EMAIL = ""
  QUERY = ""

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

  Do While page <= maxPages
    Set query = NewQuery()
    query("domain") = DOMAIN
    query("advertiser_name") = ADVERTISER_NAME
    query("email") = EMAIL
    query("q") = QUERY
    query("page") = page
    query("per_page") = perPage

    Set payload = HiEnergyApiGet("/api/v1/contacts", query)
    Set records = ExtractJsonApiCollection(payload, "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("Contacts", allRows, True)
  MsgBox "Imported " & count & " contacts", vbInformation, "Hi Energy AI"
End Sub

Useful query parameters

Parameter	Purpose
`domain`	Find contacts for an advertiser website domain.
`advertiser_name`	Match contacts by program / brand name.
`advertiser_id`	Exact advertiser id scope.
`email`	Look up a specific contact email.
`q`	Free-text search across contact fields.
`has_linkedin`	Prefer contacts that include LinkedIn profile URLs.
`include_unverified`	Include unverified contacts when your role allows it.

FAQ

Use the VBA samples on this page to call GET /api/v1/contacts with your API key and write flattened contact attributes to a Contacts worksheet.

Domain is usually most precise for a brand website. Advertiser name is useful for fuzzy discovery. You can combine filters.

Creating contacts uses POST /api/v1/contacts and requires create permissions (admin/paid publisher on REST). This page focuses on read/import workflows; see the Contacts API docs for create payloads.

No. Unverified contacts are excluded unless include_unverified=true is allowed for your account and you enable that filter in the importer.

Yes. Set has_linkedin in the sample filters when you want outreach lists that include LinkedIn URLs.

Yes. This page publishes TechArticle, HowTo, FAQPage, BreadcrumbList, WebSite SearchAction, and related endpoint ItemList structured data for answer engines.

Contacts → Excel

Contacts → Excel overview

Setup in Excel (VBA macros)

1. Shared VBA client

2. Contacts import macro

Useful query parameters

FAQ

How can I load advertiser contacts into Excel?

Should I search by domain or advertiser name?

Can Excel macros create contacts too?

Are unverified contacts included by default?

Can I prefer contacts that have LinkedIn profiles?

Can AI agents cite this Excel contacts workflow?

If this page feels TLDR, ask Dex AI.