Connect Microsoft Access to the OpenAI API with VBA

Step 1: Prepare the Table

Step 2: The Reusable AskAI Function

Option Compare Database
Option Explicit

Public Const AI_MODEL As String = "gpt-4.1-mini"   ' set to a current model
Private Const AI_URL As String = "https://api.openai.com/v1/chat/completions"

Public Function AskAI(ByVal instruction As String, ByVal inputText As String) As String
    Dim http As Object, body As String, key As String

    key = Environ("OPENAI_API_KEY")
    If Len(key) = 0 Then Err.Raise vbObjectError + 1, "AskAI", "OPENAI_API_KEY not set"

    body = "{""model"":""" & AI_MODEL & """,""temperature"":0.1," & _
           """messages"":[{""role"":""system"",""content"":""" & JsonEsc(instruction) & """}," & _
           "{""role"":""user"",""content"":""" & JsonEsc(inputText) & """}]}"

    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    http.setTimeouts 5000, 5000, 30000, 90000
    http.Open "POST", AI_URL, False
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "Authorization", "Bearer " & key
    http.send body

    If http.Status <> 200 Then
        Err.Raise vbObjectError + http.Status, "AskAI", _
                  "HTTP " & http.Status & ": " & Left$(http.responseText, 200)
    End If
    AskAI = ReadContent(http.responseText)
End Function

Private Function JsonEsc(ByVal s As String) As String
    s = Replace(s, "\", "\\"): s = Replace(s, """", "\""")
    s = Replace(s, vbCrLf, "\n"): s = Replace(s, vbCr, "\n")
    s = Replace(s, vbLf, "\n"):   s = Replace(s, vbTab, "\t")
    JsonEsc = s
End Function

Private Function ReadContent(ByVal json As String) As String
    Dim p As Long, i As Long, c As String, out As String
    p = InStr(json, """content"":")
    If p = 0 Then Exit Function
    i = InStr(p + 10, json, """") + 1
    Do While i <= Len(json)
        c = Mid$(json, i, 1)
        If c = "\" Then
            Select Case Mid$(json, i + 1, 1)
                Case "n": out = out & vbCrLf
                Case "t": out = out & vbTab
                Case Else: out = out & Mid$(json, i + 1, 1)
            End Select
            i = i + 2
        ElseIf c = """" Then
            Exit Do
        Else
            out = out & c: i = i + 1
        End If
    Loop
    ReadContent = out
End Function

Step 3: Use It on a Form

Private Sub cmdSummarise_Click()
    On Error GoTo Fail
    If Len(Nz(Me.Notes, "")) < 20 Then
        MsgBox "Not enough notes to summarise.", vbInformation: Exit Sub
    End If
    DoCmd.Hourglass True
    Me.AIResult = AskAI( _
        "Summarise these job notes in 3 bullet points for a manager. " & _
        "Include any promised dates. Do not add facts.", Me.Notes)
    Me.AIStatus = "Done"
    Me.AIModel = AI_MODEL
    Me.AIProcessedOn = Now()
    Me.AIProcessedBy = Environ("USERNAME")
    Me.Dirty = False
Done:
    DoCmd.Hourglass False
    Exit Sub
Fail:
    DoCmd.Hourglass False
    MsgBox "AI summary failed: " & Err.Description, vbExclamation
End Sub

Step 4: Batch Processing Many Records

Public Sub ClassifyPendingTickets()
    Const INSTR_TEXT As String = _
        "Classify this support ticket. Reply with exactly one of: " & _
        "Billing, Technical, Delivery, Account, Complaint, Other."
    Dim db As DAO.Database, rs As DAO.Recordset, n As Long

    Set db = CurrentDb
    ' Claim rows first so another user's batch skips them
    db.Execute "UPDATE tblTickets SET AIStatus='Processing', AIProcessedBy='" & _
               Environ("USERNAME") & "' WHERE Nz(AIStatus,'Pending')='Pending'", dbFailOnError

    Set rs = db.OpenRecordset("SELECT * FROM tblTickets WHERE AIStatus='Processing' " & _
             "AND AIProcessedBy='" & Environ("USERNAME") & "'", dbOpenDynaset)

    Do While Not rs.EOF
        rs.Edit
        On Error Resume Next
        rs!AIResult = AskAI(INSTR_TEXT, Nz(rs!Description, ""))
        If Err.Number = 0 Then
            rs!AIStatus = "Done"
        Else
            rs!AIStatus = "Error": rs!AIError = Left$(Err.Description, 255)
        End If
        Err.Clear: On Error GoTo 0
        rs!AIModel = AI_MODEL: rs!AIProcessedOn = Now()
        rs.Update
        n = n + 1
        SysCmd acSysCmdSetStatus, "Classified " & n
        DoEvents
        rs.MoveNext
    Loop
    rs.Close
    SysCmd acSysCmdClearStatus
    MsgBox n & " tickets classified.", vbInformation
End Sub

Cost, Speed and Safety

• Send only the field you need

  Not the whole record. Leave out names, phone numbers and account numbers unless the task needs them.

• Constrain outputs

  A fixed list of categories can be enforced with a lookup table and a validation query afterwards.

• Use a small model for classification

  Reserve larger models for long documents or complex drafting.

• Do not ship keys to every desktop

  In a team, route calls through one service or scheduled process that holds the key.

• Keep humans in the loop

  AI-written letters or replies should be reviewed before they leave the database.

Per-Record AI vs Whole-Database Questions