VBA function that calls OpenAI API directly from Excel cells. Pass any prompt, get AI responses inline.

Excel-VBA-GPT.vb

Option Explicit

Function AskOpenAI(prompt As String, Optional model As String = "gpt-4o-mini") As String

    On Error GoTo ErrorHandler

    ' Read API key from environment
    Dim apiKey As String
    apiKey = Environ("OPENAI_API_KEY")

    If apiKey = "" Then
        AskOpenAI = "#ERROR: OPENAI_API_KEY not found in environment variables"
        Exit Function
    End If

    ' Ensure model is never empty
    If model = "" Then model = "gpt-4o-mini"

    ' Escape the prompt for JSON
    Dim safePrompt As String
    safePrompt = Replace(prompt, "\", "\\")
    safePrompt = Replace(safePrompt, """", "\""")
    safePrompt = Replace(safePrompt, vbCrLf, "\n")
    safePrompt = Replace(safePrompt, vbCr, "\n")
    safePrompt = Replace(safePrompt, vbLf, "\n")
    safePrompt = Replace(safePrompt, vbTab, "\t")

    ' Build JSON payload
    Dim jsonBody As String
    jsonBody = "{" & _
        """model"":""" & model & """," & _
        """messages"":[{""role"":""user"",""content"":""" & safePrompt & """}]" & _
        "}"

    ' Make the API call
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")

    With http
        .Open "POST", "https://api.openai.com/v1/chat/completions", False
        .setRequestHeader "Content-Type", "application/json"
        .setRequestHeader "Authorization", "Bearer " & apiKey
        .send jsonBody

        If .Status <> 200 Then
            AskOpenAI = "#ERROR " & .Status & ": " & Left(.responseText, 200)
            GoTo Cleanup
        End If

        Dim response As String
        response = .responseText

        ' Find "content" key — handle both "content":"  and  "content": "
        Dim contentKey As String
        Dim startPos As Long

        ' Try with space first (more common in API responses)
        contentKey = """content"": """
        startPos = InStr(response, contentKey)

        ' Fall back to no space
        If startPos = 0 Then
            contentKey = """content"":"""
            startPos = InStr(response, contentKey)
        End If

        If startPos = 0 Then
            AskOpenAI = "#ERROR: No content field in response"
            GoTo Cleanup
        End If

        startPos = startPos + Len(contentKey)

        ' Walk forward to find the closing unescaped quote
        Dim i As Long
        Dim endPos As Long
        endPos = 0

        For i = startPos To Len(response)
            If Mid(response, i, 1) = """" Then
                ' Check it's not escaped
                If Mid(response, i - 1, 1) <> "\" Then
                    endPos = i
                    Exit For
                End If
            End If
        Next i

        If endPos = 0 Then
            AskOpenAI = "#ERROR: Could not find end of content"
            GoTo Cleanup
        End If

        ' Extract and unescape
        AskOpenAI = Mid(response, startPos, endPos - startPos)
        AskOpenAI = Replace(AskOpenAI, "\n", vbLf)
        AskOpenAI = Replace(AskOpenAI, "\t", vbTab)
        AskOpenAI = Replace(AskOpenAI, "\""", """")
        AskOpenAI = Replace(AskOpenAI, "\\", "\")

    End With

Cleanup:
    Set http = Nothing
    Exit Function

ErrorHandler:
    AskOpenAI = "#ERROR: " & Err.Description
    Resume Cleanup

End Function